1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68:
On Error Resume Next Const ADS_SCOPE_SUBTREE = 2 ' Search target object and all sub levels Dim objRootDSE : Set objRootDSE = GetObject("LDAP://RootDSE") strDNSDomain = Replace(Replace(objRootDSE.Get("defaultNamingContext"), ",DC=", "."), "DC=", "") strADsPath = "LDAP://" & objRootDSE.Get("defaultNamingContext") 'Connect to Active Directory 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 Dim objOU : Set objOU = GetObject("LDAP://" & TARGET_OU) Dim objExcel : Set objExcel = CreateObject("Excel.Application") Dim objWorkbook : Set objWorkbook = objExcel.Workbooks.Open(EXCEL_FILE) ' Start at Row 2, after the header. Dim intRow : intRow = 2 Do Until objExcel.Cells(intRow, 1).Value = "" Dim strUserName : strUserName = objExcel.Cells(intRow, 1).Value Dim strDisplayName : strDisplayName = objExcel.Cells(intRow, 2).Value Dim strFirstName : strFirstName = objExcel.Cells(intRow, 3).Value Dim strLastName : strLastName = objExcel.Cells(intRow, 4).Value Dim strDS : strDS = objExcel.Cells(intRow, 5).Value 'Dim strOffice : strOffice = objExcel.Cells(intRow, 6).Value Dim strPWD : strPWD = objExcel.Cells(intRow, 7).Value 'Search AD Domain to verify user Common Name does not already exist objCommand.CommandText = "SELECT distinguishedName FROM '" & strADsPath & _ "' WHERE objectCategory='user' AND cn='" & strDisplayName & "'" Set objRecordSet = objCommand.Execute If objRecordSet.EOF Then Dim objUser : Set objUser = objOU.Create("user", "CN=" & strDisplayName) objUser.Put "sAMAccountName", strUserName objUser.Put "userPrincipalName", strUserName & "@" & strDNSDomain objUser.Put "displayName", strDisplayName objUser.Put "sn", strLastName objUser.Put "givenName", strFirstName objUser.Put "description", strDS 'objUser.Put "physicalDeliveryOfficeName", strOffice objUser.Put "homeDrive", "X:" objUser.Put "homeDirectory", "\\shadowcom.local\system\profiles\" & strUsername objUser.SetInfo ' Separat sektion til import af password til brugerne objUser.userAccountControl = 512 objUser.SetPassword strPWD objUser.AccountDisabled = False objUser.SetInfo End If intRow = intRow + 1 Loop objExcel.ActiveWorkbook.Save EXCEL_FILE objExcel.ActiveWorkbook.Close objExcel.Quit