VBA to Query AD in Excel

Hello Experts,

I am using the code below to pull an alias field from AD called EID; however, I would instead like to be able to do this using either the full name or first name or last name.

Does anyone know how to modify this vba to accomplish this?

Thank you


Sub Button2_Click()

Dim EIDSheet As Worksheet
Dim InvalidEIDSheet As Worksheet
Dim intNoofEID As Integer
Dim temp As Integer
Dim i As Integer
Dim strdisplayName As String
Dim strDN As String
Dim strDNItems() As String

Dim oConnection1 As ADODB.Connection
Dim oCommand1 As ADODB.Command
Dim rs As ADODB.Recordset
Dim strQuery As String

Set EIDSheet = ThisWorkbook.Sheets("EID List")
Set InvalidEIDSheet = ThisWorkbook.Sheets("Invalid EID's")

intNoofEID = EIDSheet.UsedRange.Rows.Count
temp = 2
strdisplayName = ""
strQuery = ""

Set oConnection1 = CreateObject("ADODB.Connection")
Set oCommand1 = CreateObject("ADODB.Command")

'Open the connection.
'This is the ADSI OLE-DB provider name
oConnection1.Provider = "ADsDSOObject"
oConnection1.Open "Active Directory Provider"

Set oCommand1.ActiveConnection = oConnection1

For i = 2 To intNoofEID

    strQuery = ""
    
    strEID = Trim(EIDSheet.Cells(i, 2).Value)

    If strEID <> "" Then
    
        strQuery = "select c, SAMAccountName,displayName, distinguishedName, cn, sn,givenName,title,mail, department, manager " & _
        "from 'GC://dc=ds,dc=dummyserver,dc=com'" & _
        "WHERE objectCategory='Person'" & _
        "AND objectClass='user'" & _
        "AND sAMAccountName ='" & strEID & "'"
        
        'Compose a search string.GC://dc=ds,dc=dummyserver,dc=com
        
        oCommand1.CommandText = strQuery
        oCommand1.Properties("SearchScope") = 2
        
        ' Execute the query.
        Set rs = oCommand1.Execute
        
        If rs.RecordCount = 0 Then
          EIDSheet.Cells(i, 3).Value = "NA"
          EIDSheet.Cells(i, 4).Value = "NA"
          EIDSheet.Cells(i, 5).Value = "NA"
          EIDSheet.Cells(i, 6).Value = "NA"
          EIDSheet.Cells(i, 7).Value = "NA"
          EIDSheet.Cells(i, 8).Value = "NA"
          EIDSheet.Cells(i, 9).Value = "NA"
          
          
          EIDSheet.Activate
          Range("A" & i & ":E" & i).Select
          With Selection.Interior
            '.ColorIndex = 3
            .ColorIndex = 40
            .Pattern = xlSolid
          End With
          
          InvalidEIDSheet.Cells(temp, 1) = strdisplayName
          
          temp = temp + 1
        Else
          EIDSheet.Cells(i, 3).Value = rs.Fields("sn")
          EIDSheet.Cells(i, 4).Value = rs.Fields("givenName")
          EIDSheet.Cells(i, 5).Value = rs.Fields("mail")
          EIDSheet.Cells(i, 6).Value = rs.Fields("title")
          EIDSheet.Cells(i, 7).Value = rs.Fields("SAMAccountName")
          EIDSheet.Cells(i, 8).Value = rs.Fields("department")
          EIDSheet.Cells(i, 10).Value = rs.Fields("distinguishedName")
          strDN = EIDSheet.Cells(i, 10).Value
          strDN = Replace(strDN, ",DC=ds,DC=dummyserver,DC=com", "")
          strDNItems = Split(strDN, ",")
          EIDSheet.Cells(i, 9).Value = strDNItems(UBound(strDNItems))
       
       End If
       
    End If
    
    rs.Close
     
Next i

MsgBox "Done"

oConnection1.Close

End Sub

Open in new window

ShadowITAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

RobSampsonCommented:
It should be enough to change the samAccountName on line 47 to givenNames for first name, sn for surname, or displayName for full name.  The rest looks like it will work based on that.

Regards,

Rob.
0
ShadowITAuthor Commented:
Thanks Rob as this gets me partly there and perhaps I should further clarify my requirement.  If I change  "AND sAMAccountName ='" & strEID & "' to  "AND displayName ='" & strEID & "' this would only work provided I type in the displayName exactly as its maintained and thus I would have a single result.

Instead I would like to type in something "like" this using some sort of wildcard then then have excel render any displayName that matches this wildcard in multiple rows.   I need this because I have first and last name from another list; however, the displayName within our AD also includes a suffix value that I do not have.  For example, I have "Doe, John" but in AD it may be maintained as "Doe, John (AZ15)".  

The AZ15 designation being a mailstop for sending interoffice physical mail; useless to me but it's just a variable within the string I need to somehow content with.  If you have a better approach to this I'm all ears this is just how I decided to deal with this.  Also the AZ15 mailstop thing isn't consistent in location or length otherwise I'd just trim it off.
0
RobSampsonCommented:
Ok, so you'll need to loop through the recordset in your Else block, then increment your row counter. What do you want to happen when there are multiple results? Are the rows underneath going to be pushed down? I can write it to tonight or tomorrow morning for you if need help.

Rob.
0
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

RobSampsonCommented:
You should also find that adding the * to the cell value should already do a wildcard query, but since you're not looping the records, you only get the first record at the moment.

Rob.
0
ShadowITAuthor Commented:
Can loopig be added?
0
RobSampsonCommented:
Yep, with a For Each loop on the recordset. Are you happy to have rows inserted for multiple results?
0
ShadowITAuthor Commented:
Absolutely, this is what I desire.
0
RobSampsonCommented:
OK, try this code out.

Regards,

Rob.

Sub Button2_Click()

Dim EIDSheet As Worksheet
Dim InvalidEIDSheet As Worksheet
Dim intNoofEID As Integer
Dim temp As Integer
Dim i As Integer
Dim strdisplayName As String
Dim strDN As String
Dim strDNItems() As String
Dim intRecord As Integer

Dim oConnection1 As ADODB.Connection
Dim oCommand1 As ADODB.Command
Dim rs As ADODB.Recordset
Dim strQuery As String

Set EIDSheet = ThisWorkbook.Sheets("EID List")
Set InvalidEIDSheet = ThisWorkbook.Sheets("Invalid EID's")

intNoofEID = EIDSheet.UsedRange.Rows.Count
temp = 2
strdisplayName = ""
strQuery = ""

Set oConnection1 = CreateObject("ADODB.Connection")
Set oCommand1 = CreateObject("ADODB.Command")

'Open the connection.
'This is the ADSI OLE-DB provider name
oConnection1.Provider = "ADsDSOObject"
oConnection1.Open "Active Directory Provider"

Set oCommand1.ActiveConnection = oConnection1

For i = intNoofEID To 2 Step -1

    strQuery = ""
    
    strEID = Trim(EIDSheet.Cells(i, 2).Value)

    If strEID <> "" Then
    
        strQuery = "select c, SAMAccountName,displayName, distinguishedName, cn, sn,givenName,title,mail, department, manager " & _
        "from 'GC://dc=ds,dc=dummyserver,dc=com'" & _
        "WHERE objectCategory='Person'" & _
        "AND objectClass='user'" & _
        "AND sAMAccountName ='" & strEID & "'"

        'Compose a search string.GC://dc=ds,dc=dummyserver,dc=com
        
        oCommand1.CommandText = strQuery
        oCommand1.Properties("SearchScope") = 2
        
        ' Execute the query.
        Set rs = oCommand1.Execute
        
        If rs.RecordCount = 0 Then
          EIDSheet.Cells(i, 3).Value = "NA"
          EIDSheet.Cells(i, 4).Value = "NA"
          EIDSheet.Cells(i, 5).Value = "NA"
          EIDSheet.Cells(i, 6).Value = "NA"
          EIDSheet.Cells(i, 7).Value = "NA"
          EIDSheet.Cells(i, 8).Value = "NA"
          EIDSheet.Cells(i, 9).Value = "NA"
          
          
          EIDSheet.Activate
          Range("A" & i & ":E" & i).Select
          With Selection.Interior
            '.ColorIndex = 3
            .ColorIndex = 40
            .Pattern = xlSolid
          End With
          
          InvalidEIDSheet.Cells(temp, 1) = strdisplayName
          
          temp = temp + 1
        Else
            rs.MoveFirst
            intRecord = 0
            While Not rs.EOF
                If intRecord > 0 Then
                    EIDSheet.Rows(i + intRecord).Insert
                End If
                EIDSheet.Cells(i + intRecord, 3).Value = rs.Fields("sn")
                EIDSheet.Cells(i + intRecord, 4).Value = rs.Fields("givenName")
                EIDSheet.Cells(i + intRecord, 5).Value = rs.Fields("mail")
                EIDSheet.Cells(i + intRecord, 6).Value = rs.Fields("title")
                EIDSheet.Cells(i + intRecord, 7).Value = rs.Fields("SAMAccountName")
                EIDSheet.Cells(i + intRecord, 8).Value = rs.Fields("department")
                EIDSheet.Cells(i + intRecord, 10).Value = rs.Fields("distinguishedName")
                strDN = EIDSheet.Cells(i + intRecord, 10).Value
                strDN = Replace(strDN, ",DC=ds,DC=dummyserver,DC=com", "")
                strDNItems = Split(strDN, ",")
                EIDSheet.Cells(i + intRecord, 9).Value = strDNItems(UBound(strDNItems))
                intRecord = intRecord + 1
                rs.MoveNext
            Wend
       End If
       
    rs.Close
    
    End If
     
Next i

MsgBox "Done"

oConnection1.Close

End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
ShadowITAuthor Commented:
I got a VBA error and I have attached both the error msg and the line within the debugger.
VBAErrorMsg.jpg
Debugger.jpg
0
RobSampsonCommented:
You need to change the server reference from
GC://dc=ds,dc=dummyserver,dc=com

So that you query the right domain.

Rob.
0
ShadowITAuthor Commented:
...show's you where my head is at  :(.  Now I feel like Sulu in the last Star Trek movie where the asked him if he forgot to take off the parking park when they couldn't go into warp.
0
ShadowITAuthor Commented:
Perfect!
0
RobSampsonCommented:
Thanks for the grade. Glad it was what you needed.

Rob.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.