[VBA] - Daten aus AD abfragen

[EasY]

Hi Leute,

ich kann zwar ein wenig VBA (selbst beigebracht), aber was Netzwerkstrukturen angeht, bin ich überfragt. Ich habe das Kürzel eines Mitarbeiters aus dem ActiveDirectory. Nun möchte ich automatisiert in der nebenstehenden Zelle seine/ihre E-Mailadresse auslesen. Ich habe im Internet bereits einige Code-Schnipsel gefunden, kann sie allerdings nicht so anpassen, dass sie auf meinen Anwendungsfall passen. Vielleicht hat ja jemand eine zündende Idee :)

Der Code liest erfolgreich Namen und E-Mail-Adresse von mir als Benutzer aus. Allerdings suche ich ja andere Benutzer.

Code:

Sub Test()

Dim oADInfo As Object
Dim sUserName As String
Dim ouser As Object
Dim sMailAdd As String
Dim sName As String

' Auslesen der Daten aus dem Active Directory
Set oADInfo = CreateObject("ADSystemInfo")
sUserName = oADInfo.UserName
Set ouser = GetObject("LDAP://" & sUserName)

' Filterung bestimmter Daten
' cn = der Name, für jedes Objekt gibt es eine Abkürzung
sMailAdd = ouser.mail
sName = ouser.samaccountname

' Einfügen der Daten
Worksheets("Tabelle1").Range("A3").FormulaLocal = sName
Worksheets("Tabelle1").Range("A4").FormulaLocal = sMailAdd
Set ouser = Nothing
Set oADInfo = Nothing


End Sub

Der Code soll Domäne und Name abfragen und dann etwas ausgeben. Allerdings funktioniert das nicht bei mir. Ich habe keine Domäne und auch nicht den Namen, sondern nur das Kürzel welches mit "samaccountname" ausgelesen wird. Soweit war ich zumindest schon.

Code:

Function funcADUserLookup(ad_field, sSearch, sADDomain)
Dim objConn As Object, objCommand As Object, objRS As Object
Dim strSQL As Variant
    On Error Resume Next
    Set objConn = CreateObject("ADODB.Connection")
    objConn.Provider = "ADsDSOObject"
    objConn.Open "Active Directory Provider"
    Set objCommand = CreateObject("ADODB.Command")
    objCommand.ActiveConnection = objConn
    strSQL = "SELECT " & ad_field & " FROM 'LDAP://" & sADDomain & "' WHERE samaccountname = '"  _
_
& _
sSearch & "'"
    objCommand.CommandText = strSQL
    Set objRS = objCommand.Execute
    funcADUserLookup = objRS.Fields(ad_field).Value
   
    Set objConn = Nothing
    Set objCommand = Nothing
    Set objRS = Nothing
End Function
Sub Test_Ablauf()
Dim oWSHShell As Object
Dim dom As String, sUser As String, sADDomain As String
Dim ouser As String, mail As String
On Error Resume Next
Set oWSHShell = CreateObject("Wscript.Shell")
dom = InputBox("domaene")
sUser = InputBox("user")
sADDomain = dom
ouser = funcADUserLookup("distinguishedName", sUser, sADDomain)
mail = funcADUserLookup("mail", sUser, sADDomain)
If ouser = "" Then
MsgBox sUser & " nicht gefunden!"
Else
MsgBox ouser & vbCrLf & mail & vbCrLf
End If
Set oWSHShell = Nothing
End Sub

Danke und Gruß

[schauan]

Hallöchen,

von Microsoft gibt es bei den Powertools auch einen AD-Explorer. Damit kannst Du erst mal den user suchen und Dir damit ggf. auch ein paar Tipps für die Syntax der Abfrage rausholen.
Hast Du den schon mal ausprobiert?

[Fennek]

Hallo,

warum soll es VBA sein und nicht PowerShell?

https://administrator.de/forum/user-attr...95495.html

mfg

[EasY]

Hey ihr, 

schonmal vielen Dank für eure Antworten. Ich möchte das auf einem Arbeitsrechner nutzen, auf dem ich keinerlei Programme installieren oder sonstige Veränderungen vornehmen darf und kann. 
Ich möchte die Daten in Excel weiternutzen und fühle mich da auch einigermaßen wohl. Um mich in ein neues Prozedere einzuarbeiten habe ich gerade nicht so viel Zeit . Offensichtlich funktioniert es ja auch mit VBA, ich weiß nur nicht wie :)
Ansonsten soll die datei irgendwann narrensicher sein, sodass ich sie guten Gewissens auch anderen Kollegen überlassen kann.

[schauan]

Hallöchen,

den AD-Explorer braucht man nicht installieren
Eine gute Seite ist z.B. die von SELFADSI

Hier mal was, was ich im Einsatz hatte:

Code:

Function GetEmail(login)
Dim rootDSE, Connection, cmd, result
    Set rootDSE = GetObject("LDAP://rootDSE")
    Set Connection = CreateObject("ADODB.Connection")
    Connection.Provider = "ADsDSOObject"
    Connection.Open
    Set cmd = CreateObject("ADODB.Command")
    Set cmd.ActiveConnection = Connection
    cmd.CommandText = "SELECT mail FROM 'LDAP://" & rootDSE.Get("defaultNamingContext") & "' " & " WHERE objectCategory='person' AND sAMAccountName='" & login & "'"
    'Statt Login der angezeigte Name:
    'cmd.CommandText = "SELECT mail FROM 'LDAP://" & rootDSE.Get("defaultNamingContext") & "' " & " WHERE objectCategory='person' AND dn='" & DisplayName & "'"
    Set result = cmd.Execute
    If (Not (result.EOF)) Then
        If Not (IsNull(result.Fields("mail"))) Then
            Debug.Print (result.Fields("mail"))
            GetEmail = result.Fields("mail")
        End If
    End If

    result.Close
    Connection.Close
End Function

PowerShell hat sicher Vorteile, aber ist zum einen zuweilen unterdrückt und zum anderen gegenüber VBA ein externes Tool.
Im VBA würde man dafür aber nur das Script starten und anschließend noch die Ergebnisse einlesen
Oder man macht alles aus PowerShell heraus, Daten abrufen, ggf. als csv speichern und in Excel aktualisieren
stackoverflow-powershell-script-open-excel-update-external-data-save-as
In Excel wäre zur Vorbereitung eine Abfrage einzurichten.

[EA1950]

Hallo,

vielleicht hilft dir folgender Beitrag weiter:
mittels VBA Vorname und Nachname aus AD auslesen und einfüge Office-Loesung.de

[schauan]

Hallöchen,

der erste Code hier sieht dem aus Beitrag 5 von dort ziemlich ähnlich