Spreadsheet: 797288d1663802554-excel-vba-ldap-emails-active-directory-trouble-with-range-code-vba-ldap-ad-email-lookup
Sheet: Sheet1

Dim userinfo(15) As [NAME]
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, "[EMAIL]")   **<---- 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 [NAME], [NAME] As Boolean, Optional mail As [NAME], Optional gigid As [NAME]) As [NAME]
Dim AFDS As [NAME]
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 [NAME]") = 1
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
AFDS = ADaddress()
'setup AFDS query
If [NAME] 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.[NAME]
'        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