Active Directory in SQL-DB importieren

 
On Error Resume Next

'Variablen und Konstanten deklarieren und initiieren  
Const ADS_SCOPE_SUBTREE = 2
intID = 1

'TXT- File erstellen  
Set objFS = CreateObject("Scripting.FileSystemObject")  
Set TXTFile = objFS.CreateTextFile("\\SERVERNAME\ORDNERNAME\DATEINAME.txt", True)  

'Kopfzeile mit den Spaltenüberschriften in der TXT- Datei hinterlegen  
TXTFile.WriteLine ("ID" & "; " & "EmployeeID" & "; " & "Class" & "; " & "SN" & "; "& "GivenName" & "; "& "DisplayName" _  
	 & "; "& "CN" & "; "& "Name" & "; "& "Initials" & "; "& "Description" & "; "& "PhysicalDeliveryOfficeName" & "; "& "TelephoneNumber" _  
	 & "; "& "OtherTelephone" & "; "& "Mail" & "; "& "WWWHomepage" & "; "& "StreetAddress" & "; "& "PostOfficeBox" & "; "& "City" _  
	 & "; "& "Kanton" & "; "& "PLZ" & "; "& "Country" & "; "& "Country_Short" & "; "& "Country_Code" & "; "& "UserPrincipalName" _  
	 & "; "& "SamAccountName" & "; "& "UserWorkstations" & "; "& "BadPwdCount" & "; "& "UserAccountControl" & "; "& "AccountExpirationDate" _  
	 & "; "& "ProfilePath" & "; "& "ScriptPath" & "; "& "HomeDirectory" & "; "& "HomeDrive" & "; "& "HomePhone" & "; "& "OtherHomePhone" _  
	 & "; "& "Pager" & "; "& "OtherPager" & "; "& "Mobile" & "; "& "OtherMobile" & "; "& "FAX" & "; "& "OtherFAX" & "; "& "IPPhone" _  
	 & "; "& "OtherIPPhone" & "; "& "Info" & "; "& "Title" & "; "& "Department" & "; "& "Company" & "; "& "Manager" _  
	 & "; "& "TerminalServicesProfilePath" & "; "& "TerminalServicesHomeDirectory" & "; "& "TerminalServicesHomeDrive" & "; "& "AllowLogon" _  
	 & "; "& "WhenCreated" & "; "& "WhenChanged" & "; "& "HomeMDB" & "; "& "MailNickname" & "; "& "MsExchHomeServerName" & "; "& "HomeMTA" _  
	 & "; "& "LegacyExchangeDN" & "; "& "DisplayNamePrintable" & "; "& "MsExchHideFromAddressLists" & "; "& "DistinguishedName" _  
	 & "; "& "ADS-Server1" & "; "& "ADS-Server2" & "; "& "ADS-Server3")  
	 
'Active- Directory- Verbindung herstellen   
Set objConnection = CreateObject("ADODB.Connection")  
Set objCommand =   CreateObject("ADODB.Command")  
objConnection.Provider = "ADsDSOObject"  
objConnection.Open "Active Directory Provider"  
Set objCommand.ActiveConnection = objConnection

objCommand.Properties("Page Size") = 1000  
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE   

'AD- Kommando erstellen -> Alle Kontakte und User auflisten  
objCommand.CommandText = "SELECT distinguishedName FROM 'LDAP://dc=DOMAIN,dc=TOPLEVELDOMAIN' WHERE objectCategory='user'"    
Set objRecordSet = objCommand.Execute

objRecordSet.MoveFirst
Do Until objRecordSet.EOF
	'Für jeden ausgelesenen Wert, Kontakt- und User- Informationen auswerten  
	strLDAP = "LDAP://" & objRecordset.Fields("distinguishedName").Value  
    Set objUser = GetObject(strLDAP)
    
    'AD- Daten an Variablen übergeben  
    	'Generelle Personendaten  
		If objUser.EmployeeID = " " Then  
			strEmployeeID = ""  
		Else
			strEmployeeID = objUser.EmployeeID
		End If
		strClass = objUser.Class
		strSN = objUser.sn
		strGivenName = objUser.givenName
		strDisplayName = objUser.displayName
		strCN = objUser.cn
		strName = objUser.name
		strInitials = objUser.initials
		strDescription = objUser.Description
		strOffice = objUser.physicalDeliveryOfficeName
		If objUser.telephoneNumber = "-" Then  
			strPhone = ""  
		Else
			strPhone = objUser.telephoneNumber
		End If
		If objUser.otherTelephone = "-" Then  
			strOtherPhone = ""  
		Else
			strOtherPhone = objUser.otherTelephone
		End If
		If objUser.mail = "NoEmailAdress@bell.ch" Then  
			strMail = ""  
		Else
			strMail = objUser.mail
		End If
		strHomepage = objUser.wwwHomepage
    
		'Adressdaten  
		strStreetAddress = objUser.streetAddress
		strPostOfficeBox = objUser.postOfficeBox
		strCity = objUser.l
		strKanton = objUser.st
		strPLZ = objUser.postalCode
		strCountry = objUser.co
		strCountry_Short = objUser.c
		If objUser.countryCode = "0" Then  
			strCountry_Code = ""  
		Else
			strCountry_Code = objUser.countryCode
		End If

		'Accountdaten  
		strUserPrincipalName = objUser.userPrincipalName
		strSamAccountName = objUser.samAccountName
		strUserWorkstations = objUser.userWorkstations
		strBadPwdCount = objUser.badPwdCount
		strUserAccountControl = objUser.userAccountControl
		If objUser.accountExpirationDate = "01.01.1601 02:00:00" Or objUser.accountExpirationDate = "01.01.1970" Then  
			strAccountExpirationDate = ""  
		Else
			strAccountExpirationDate = objUser.accountExpirationDate
		End If
				
		'Profildaten  
		strProfilePath = objUser.profilePath
		strScriptPath = objUser.scriptPath
		strHomeDirectory = objUser.homeDirectory
		strHomeDrive = objUser.homeDrive

		'Kontaktdaten  
			'HomePhone  
			If objUser.homePhone = "-" Then  
				strHomePhone = ""  
			Else
				strHomePhone = objUser.homePhone
			End If
			'OtherHomePhone  
			If objUser.otherHomePhone = "-" Then  
				strOtherHomePhone = ""  
			Else
				strOtherHomePhone = objUser.otherHomePhone
			End If
			'Pager  
			If objUser.pager = "-" Then  
				strPager = ""  
			Else
				strPager = objUser.pager
			End If
			'OtherPager  
			If objUser.otherPager = "-" Then  
				strOtherPager = ""  
			Else
				strOtherPager = objUser.otherPager
			End If
			'Mobile  
			If objUser.mobile = "-" Then  
				strMobile = ""  
			Else
				strMobile = objUser.mobile
			End If
			'OtherMobile  
			If objUser.otherMobile = "-" Then  
				strOtherMobile = ""  
			Else
				strOtherMobile = objUser.otherMobile
			End If
			'FAX  
			If objUser.facsimileTelephoneNumber = "-" Then  
				strFAX = ""  
			Else
				strFAX = objUser.facsimileTelephoneNumber
			End If
			'OtherFAX  
			If objUser.otherFacsimileTelephoneNumber = "-" Then  
				strOtherFAX = ""  
			Else
				strOtherFAX = objUser.otherFacsimileTelephoneNumber
			End If
			'IPPhone  
			If objUser.ipPhone = "-" Then  
				strIPPhone = ""  
			Else
				strIPPhone = objUser.ipPhone
			End If
			'OtherIPPhone  
			If objUser.otherIpPhone = "-" Then  
				strOtherIPPhone = ""  
			Else
				strOtherIPPhone = objUser.otherIpPhone
			End If
			'Info  
            strInfo = objUser.info
 
		'Organisationsdaten  
		strTitle = objUser.Title
		strDepartment = objUser.department
		strCompany = objUser.company
		strManager = objUser.manager
            	
		'Terminal Service- Daten  
		strTerminalServicesProfilePath = objUser.TerminalServicesProfilePath
		strTerminalServicesHomeDirectory = objUser.TerminalServicesHomeDirectory
		strTerminalServicesHomeDrive = objUser.TerminalServicesHomeDrive
		strAllowLogon = objUser.AllowLogon

		'Objektdaten auswertem  
		strWhenCreated = objUser.whenCreated
		strWhenChanged = objUser.whenChanged

		'Exchangedaten auswerten  
		strHomeMDB = objUser.homeMDB
		strMailNickname = objUser.mailNickname
		strMsExchHomeServerName = objUser.msExchHomeServerName
		strHomeMTA = objUser.homeMTA
		strLegacyExchangeDN = objUser.legacyExchangeDN
		strDisplayNamePrintable = objUser.displayNamePrintable
		strMsExchHideFromAddressLists = objUser.msExchHideFromAddressLists
    
    	'Diverses  
    	strDistinguishedName = objUser.distinguishedName
    	
    	'LastLogin  
    	strADSServer1 = ""  
		strADSServer2 = ""  
		strADSServer3 = ""  
		
		If strClass = "user" Then  
			Set objUser = GetObject("LDAP://ADS-Server1/" & strDistinguishedName)  
	        strADSServer1 = objUser.LastLogin
			Set objUser = GetObject("LDAP://ADS-Server2/" & strDistinguishedName)  
			strADSServer2 = objUser.LastLogin
			Set objUser = GetObject("LDAP://ADS-Server3/" & strDistinguishedName)  
			strADSServer3 = objUser.LastLogin
		End If
    
    'Werte an TXT- File übergeben   	  
    TXTFile.WriteLine ("" & intID & ";" & strEmployeeID & ";" & strClass & ";" & strSN & ";" & strGivenName & ";" _  
    	& strDisplayName & ";" & strCN & ";" & strName & ";" & strInitials & ";" & strDescription & ";" & strOffice & ";" _  
    	& strPhone & ";" & strOtherPhone & ";" & strMail & ";" & strHomepage & ";" & strStreetAddress & ";" _  
    	& strPostOfficeBox & ";" & strCity & ";" & strKanton & ";" & strPLZ & ";" & strCountry & ";" & strCountry_Short & ";" _  
    	& strCountry_Code & ";" & strUserPrincipalName & ";" & strSamAccountName & ";" & strUserWorkstations & ";" _  
    	& strBadPwdCount & ";" & strUserAccountControl & ";" & strAccountExpirationDate & ";" & strProfilePath & ";" _  
    	& strScriptPath & ";" & strHomeDirectory & ";" & strHomeDrive & ";" & strHomePhone & ";" & strOtherHomePhone & ";" _  
    	& strPager & ";" & strOtherPager & ";" & strMobile & ";" & strOtherMobile & ";" & strFAX & ";" & strOtherFAX & ";" _  
    	& strIPPhone & ";" & strOtherIPPhone & ";""" & strInfo & """;" & strTitle & ";" & strDepartment & ";" & strCompany & ";" _  
    	& strManager & ";" & strTerminalServicesProfilePath & ";" & strTerminalServicesHomeDirectory & ";" _  
    	& strTerminalServicesHomeDrive & ";" & strAllowLogon & ";" & strWhenCreated & ";" & strWhenChanged & ";" & strHomeMDB & ";" _  
    	& strMailNickname & ";" & strMsExchHomeServerName & ";" & strHomeMTA & ";" & strLegacyExchangeDN & ";" _  
    	& strDisplayNamePrintable & ";" & strMsExchHideFromAddressLists & ";" & strDistinguishedName & ";" & strADSServer1 & ";" _  
    	& strADSServer2 & ";" & strADSServer3 & "")  
    	   	
	'Nächster Datensatz auswählen  
	objRecordSet.MoveNext
	
	'Counter und ID um jeweils 1 erhöhen  
	intID = intID + 1
Loop

'TXT- File schliessen  
TXTFile.Close