I'm trying to go through 20k employee email addresses to pull information from an Active Directory. The below code worked with a single email actually typed out in VBA, but I'm trying to use the code to go through all the emails in a single column list and return values in an adjacent column in Excel.
Ex. Searched Email: chuck.norris@us.navy.mil
Desired Outlook Title Return: NORRIS, CHUCK P KARATE USNC 318 COBRA/KAI
I have also tried these lines: ActiveSheet.Range("A1").Value = gigIDldap(4, True, Range("B1")) ActiveSheet.Range("A2:A3").Value = gigIDldap(4, True, Range("B2:B3"))
The first one referencing a single cell works, the 2nd one referencing a range of cells doesn't. I have verified that emails are in cells B1 to B3.
Sub TEST()
'call function as follows: <VARIABLE> = gigIDldap(<INDEX>, True, <EMAIL>)
'Available indexes:
'userinfo(0) = .givenName
'userinfo(1) = .Initials
'userinfo(2) = .LastName
'userinfo(3) = .personalTitle
'userinfo(4) = .DisplayName
'userinfo(5) = .userPrincipalName
'userinfo(6) = .o
'userinfo(7) = .sAMAccountName
'userinfo(8) = .mail
'userinfo(9) = .physicalDeliveryOfficeName
'userinfo(10) = .telephoneNumber
'userinfo(11) = .l
'userinfo(12) = .c
'userinfo(13) = .Title
'userinfo(14) = .Department
'userinfo(15) = .company
ActiveSheet.Cells(2, 2).Value = gigIDldap(4, True, "Chuck.Norris@us.mail.mil") **<---- This line works**
ActiveSheet.Range(“A1:A5”).Value = gigIDldap(4, True, Range(“B1:B5”)) **<--- This is my attempt at looking up 5 emails and returning the values in 5 adjacent cells. It does not work.**
End Sub
Function ADaddress()
'This script can determine the AD directory required for LDAP queries
Set objSysInfo = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objSysInfo.UserName)
dname = objUser.distinguishedName
DLoc = InStr(dname, "DC=")
ADaddress = Right(dname, Len(dname) - DLoc + 1)
End Function
Public Function gigIDldap(infoIndex As Integer, useEmail As Boolean, Optional mail As String, Optional gigid As String) As Variant
Dim AFDS As String
Const ADS_SCOPE_SUBTREE = 2
If gigid = "" Then gigid = "1"
If userinfo(8) = mail Or userinfo(7) = gigid Then
gigIDldap = userinfo(infoIndex)
Exit Function
End If
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") = 1
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
AFDS = ADaddress()
'setup AFDS query
If useEmail Then
objCommand.CommandText = "SELECT * FROM 'LDAP://" & AFDS & "' WHERE objectCategory='user' AND mail='" & mail & "'"
Else
objCommand.CommandText = "SELECT * FROM 'LDAP://" & AFDS & "' WHERE objectCategory='user' AND gigid='" & gigid & "'"
End If
Set objRecordSet = objCommand.Execute
If objRecordSet.RecordCount = 0 Then
gigid = ""
Exit Function
Else
objRecordSet.MoveFirst
End If
Set objUser = GetObject(objRecordSet.Fields("ADsPath").Value)
With objUser
userinfo(0) = .givenName
userinfo(1) = .Initials
userinfo(2) = .LastName
userinfo(3) = .personalTitle
userinfo(4) = .DisplayName
userinfo(5) = .userPrincipalName
userinfo(6) = .o
userinfo(7) = .sAMAccountName
userinfo(8) = .mail
userinfo(9) = .physicalDeliveryOfficeName
userinfo(10) = .telephoneNumber
userinfo(11) = .l
userinfo(12) = .c
userinfo(13) = .Title
userinfo(14) = .Department
userinfo(15) = .company
'Debug.Print userinfo(12)
End With
gigIDldap = userinfo(infoIndex)
'available fields for objUser:
' With objUser
' Debug.Print .adminDescription
' Debug.Print .adminDisplayName
' Debug.Print .altSecurityIdentities
' Debug.Print .buildingName
' Debug.Print .c
' Debug.Print .cn
' Debug.Print .codePage
' Debug.Print .company
' Debug.Print .countryCode
' Debug.Print .delivContLength
' Debug.Print .Department
' Debug.Print .directReports
' Debug.Print .DisplayName
' Debug.Print .distinguishedName
' Debug.Print .dLMemDefault
' Debug.Print .employeeID
' Debug.Print .employeeType
' Debug.Print .extensionAttribute13
' Debug.Print .gigid
' Debug.Print .givenName
' Debug.Print .homeMDB
' Debug.Print .homeMTA
' Debug.Print .iaTrainingDate
' Debug.Print .Initials
' Debug.Print .instanceType
' Debug.Print .l
' Debug.Print .legacyExchangeDN
' Debug.Print .logonCount
' Debug.Print .mail
' Debug.Print .mailNickname
' Debug.Print .Manager
' Debug.Print .mDBOverHardQuotaLimit
' Debug.Print .mDBOverQuotaLimit
' Debug.Print .mDBStorageQuota
' Debug.Print .mDBUseDefaults
' Debug.Print .MiddleName
' Debug.Print .msExchALObjectVersion
' Debug.Print .msExchDelegateListBL
' Debug.Print .msExchELCMailboxFlags
' Debug.Print .msExchExtensionCustomAttribute1
' Debug.Print .msExchHideFromAddressLists
' Debug.Print .msExchHomeServerName
' Debug.Print .msExchMailboxGuid
' Debug.Print .msExchMDBRulesQuota
' Debug.Print .msExchPoliciesExcluded
' Debug.Print .msExchRBACPolicyLink
' Debug.Print .msExchRecipientDisplayType
' Debug.Print .msExchSafeSendersHash
' Debug.Print .msExchUMEnabledFlags2
' Debug.Print .msExchUserAccountControl
' Debug.Print .msExchUserCulture
' Debug.Print .msExchWhenMailboxCreated
' Debug.Print .Name
' Debug.Print .o
' Debug.Print .objectCategory
' Debug.Print .objectGUID
' Debug.Print .objectSid
' Debug.Print .payGrade
' Debug.Print .payPlan
' Debug.Print .personalTitle
' Debug.Print .physicalDeliveryOfficeName
' Debug.Print .PostalCode
' Debug.Print .primaryGroupID
' Debug.Print .replicatedObjectVersion
' Debug.Print .replicationSignature
' Debug.Print .roomNumber
' Debug.Print .sAMAccountName
' Debug.Print .sAMAccountType
' Debug.Print .sIDHistory
' Debug.Print .sn
' Debug.Print .st
' Debug.Print .street
' Debug.Print .StreetAddress
' Debug.Print .submissionContLength
' Debug.Print .telephoneNumber
' Debug.Print .textEncodedORAddress
' Debug.Print .Title
' Debug.Print .URL
' Debug.Print .userAccountControl
' Debug.Print .UserCertificate
' Debug.Print .userPassword
' Debug.Print .userPrincipalName
' Debug.Print .userSMIMECertificate
' Debug.Print .whenChanged
' Debug.Print .whenCreated
' End With
End Function```