X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
   Reply to this topicStart new topic
> Ldap Query From VBA /vbs, Access 2016    
post Sep 20 2017, 11:02 AM

Posts: 188
Joined: 12-August 10

Good day UA,

I hope everyone is well. It has been a long time since I have been here and I hope the UA gurus have some insight for my issue.

I am trying to pull data from our company LDAP using VBA/VBS into either XLS or Access Table. I found quite a few handy scripts online but nothing is working.

Internally we have a reference page citing a VBS script that supposedly works to pull data from our internal LDAP. The jest of what they suggest using is below.

I found a lot of hints online to modify the below code and still have yet to produce a Excel Spreadsheet with any data other than the headers. Does anyone have a good reference article
I can start with, general help or maybe some example code that has worked for them?

Thanks in advance for the help as always........(sorry if this is in the wrong forum)

Dim arrAttrs, arrLabels

arrAttrs = Array("employeenumber", "alias", "cn", "sn", "givenname", "mail", "telephonenumber", "mobile", "hometelephonenumber", "personalmobile", "c", "l", "slbitbuilding", "employeetype", "locationcostcodehris", "businesscategory", "jobgroup", "jobcategory", "jobtitle", "jobcode")
'arrAttrs = Array("employeenumber", "alias", "cn")
arrLabels = Array("GIN", "Alias", "Full Name", "Last Name", "First Name", "Email Address", "Office Phone", "Mobile Phone", "Home Phone", "Home Mobile", "County", "City", "Building ID", "Person Type", "Cost Center", "Business Category", "Job Group", "Job Category", "Job Title", "Job Code")

' Setup Excel object
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True

' Create header row with attribute labels
For i = 0 To UBound(arrAttrs)
objExcel.Cells(1, i + 1).Value = arrLabels(i)

' Setup connection to LDAP server
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "'CompanyNameHere' LDAP Directory"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

' Construct database query
'objCommand.CommandText = " SELECT " & Join(arrAttrs, ",") & vbCrLf _
' & " FROM 'LDAP://ldap.xxxx.com/o=slb,c=an' " & vbCrLf _
' & " WHERE objectclass='inetorgperson' " & vbCrLf _
' & " AND sn='*Fleeman'"

' Execute the database query and write results to Excel object
Set objRecordSet = objCommand.Execute
' start writing at the second row
x = 2
Do Until objRecordSet.EOF
For i = 0 To UBound(arrAttrs)
objExcel.Cells(x, i + 1).Value = objRecordSet.Fields(arrAttrs(i)).Value
x = x + 1

' Turn on the AutoFilter
If objExcel.AutoFilterMode = False Then
End If
Go to the top of the page
post Sep 20 2017, 11:14 AM

Posts: 894
Joined: 25-April 14

if you need a recordset put in excel, do not loop thru the recordset and cells.
instead paste it all in 1 command:

range("a1").CopyFromRecordset rst
Go to the top of the page
post Sep 20 2017, 01:33 PM

Posts: 188
Joined: 12-August 10

Thanks for the quick reply.

I changed the SELECT statement slightly from original script after doing some reading online. objRecordSet returns back empty and there is a compile error. I think I realized the issue..... I am creating script from reference link but I think the underlying assumption is I also have a connection created to the SQL server backend (which I don't) . So essentially the Set objConnection has no data in it. Any hints on where I can do some reading on this further? Thanks!

'***NEW SELECT***'
objCommand.CommandText = " SELECT & Join(arrAttrs) FROM LDAP('(|(alias=fleeman)(alias=shatterman))',null,null)"

Set objRecordSet = objCommand.Execute

'***OLD SELECT***'
'objCommand.CommandText = " SELECT " & Join(arrAttrs, ",") & vbCrLf _
' & " FROM 'LDAP://ldap.xxxxx.com/o=slb,c=an' " & vbCrLf _
' & " WHERE objectclass='inetorgperson' " & vbCrLf _
' & " AND sn='*Buscher'"
Go to the top of the page
post Sep 20 2017, 05:03 PM

UtterAccess VIP
Posts: 10,940
Joined: 6-December 03
From: Telegraph Hill

That SQL won't work. Join() is a VBA function that concatenates all the elements in an array using the passed delimiter.

You've removed the delimiter and included it in the literal SQL string.

objCommand.CommandText = "SELECT " & & Join(arrAttrs, ",") & " FROM LDAP('(|(alias=fleeman)(alias=shatterman))',null,null)"

Of course, this assumes your revised 'FROM' clause is correct - something about which I have no idea!


Go to the top of the page
post Sep 21 2017, 03:25 PM

Posts: 78
Joined: 12-March 06
From: Redmond, WA

Quick note looking at your original code. You need to uncomment setting the commandtext line. It's executing nothing. Try that.
I have routines for LDAP but they differ a bit. Let me know if this works first. If not, I can dig up some old routines.
Go to the top of the page

Custom Search

RSSSearch   Top   Lo-Fi    19th March 2019 - 10:01 AM