hi Gerard,
I am looking for a solution for getting domain user's name and surname using
VBA. I tried to use the code from mvps.org
(
http://www.mvps.org/access/api/api0008.htm) but I found this solution not
usable.
What's wrong with it?
btw, may be you are looking for something like that:
Public Function searchInAD( _
Optional sAMAccountName As Variant = Null, _
Optional sn As Variant = Null, _
Optional givenname As Variant = Null, _
Optional department As Variant = Null, _
Optional displayname As Variant = Null)
Dim objconn As Object
Dim objCommand As Object
Dim objRoot As Object
Dim objDomain As Object
Dim objRS As Object
Dim strDomain As String
Dim strSQL As String
Dim varSearch As Variant
On Error GoTo PROC_ERR
'ADO Connection ins AD aufbauen
Set objconn = CreateObject("ADODB.Connection")
objconn.Provider = "ADsDSOObject"
objconn.Open "Active Directory Provider"
'Command Objekt instanziieren und definieren
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objconn
'Pfad ins AD holen
Set objRoot = GetObject("LDAP://rootDSE")
strDomain = objRoot.Get("defaultNamingContext")
Set objDomain = GetObject("LDAP://" & strDomain)
'Query aufbauen
strSQL = "SELECT displayname, cn, " & _
"sAMAccountName, company, givenname, " & _
"sn, l, mail, department, telephoneNumber, " & _
"facsimileTelephoneNumber, " & _
"physicalDeliveryOfficeName" & _
" FROM 'LDAP://" & strDomain & "'" & _
" WHERE "
'Bedingung aufbauen
varSearch = Null
If Not IsNull(sAMAccountName) Then
varSearch = "sAMAccountName='" & sAMAccountName & "'"
End If
If Not IsNull(sn) Then
varSearch = (varSearch + " AND ") & _
"sn='" & sn & "*'"
End If
If Not IsNull(givenname) Then
varSearch = (varSearch + " AND ") & _
"givenname='" & givenname & "*'"
End If
If Not IsNull(department) Then
varSearch = (varSearch + " AND ") & _
"department='" & department & "*'"
End If
If Not IsNull(displayname) Then
varSearch = (varSearch + " AND ") & _
"displayname='" & displayname & "*'"
End If
'SQL Statement zusammensetzen
If Not IsNull(varSearch) Then
strSQL = strSQL & varSearch
End If
'und Befehl dem CommandObject übergeben
objCommand.CommandText = strSQL
'Query ausführen
Set objRS = objCommand.Execute
'Gefundene Einträge abarbeiten
If objRS.RecordCount > 0 Then
With objRS
.MoveFirst
While Not .EOF
Debug.Print "DisplayName = " & Nz(!displayname)
Debug.Print "Alias = " & Nz(!cn)
Debug.Print "PID = " & Nz(!sAMAccountName)
Debug.Print "BU = " & Nz(!company)
Debug.Print "FirstName = " & Nz(!givenname)
Debug.Print "LastName = " & Nz(!sn)
Debug.Print "Location = Nz(!l)"
Debug.Print "EMail = " & Nz(!mail)
Debug.Print "Departement = " & Nz(!department)
Debug.Print "Phone = " & Nz(!telephoneNumber)
Debug.Print "Fax = " & Nz(!facsimileTelephoneNumber)
Debug.Print "Office = " & Nz(!physicalDeliveryOfficeName)
.MoveNext
Wend
.Close
End With
End If
PROC_EXIT:
Set objRS = Nothing
Set objconn = Nothing
Exit Function
PROC_ERR:
MsgBox "Fehler beim Lesen des AD. Fehler-Nr. " & _
Err.Number & vbCrLf & vbCrLf & _
Err.Description & vbCrLf & vbCrLf & _
"Zusatzinformation: " & vbCrLf & _
"Domain = " & strDomain & vbCrLf & _
"Command: " & vbCrLf & strSQL
Resume PROC_EXIT
End Function
(from Henry Habermacher)
mfG
--> stefan <--
