VBA AD auslesen

[redryder 10]

Hallo Community,

ich habe eine Frage, wenn ich in Office das AD auslesen will, auf welche Werte greift VBA dann zurück ( wo liest es die aus)?

Ich habe im AD bei den Usern eigentlich alle Attribute, die ich benötige gefüllt.

Leider leifert VBA mir trotzdem einige leere Werte beim auslesen zurück.

 

Hier mein kl. Code:

 

Private Sub Document_New()
On Error Resume Next
Dim user As String, short As String
Dim qQuery, objSysInfo, objUser
Dim Firma, Name, EMail, Phone, Fax, WWW, Position, Abteilung
MsgBox "halt AD prüfen"
If ThisDocument.Name = "Vorlage-dt.dot" Or ThisDocument.Name = "Vorlage-en.dot" Or ThisDocument.Name = "Vorlage_neu_AD.dot" And _
ThisDocument.Path = "\\primtx200\dokumente\" Or ThisDocument.Path = "\\primtx200\dokumente\verkauf\" Or _
ThisDocument.Path = "\\primtx200\einkauf\" Or ThisDocument.Path = "\\sr-file01\home\User\Eigene Dateien\Briefvorlage" Then
    'Active Directory Informationen des angemeldeten Users abrufen
    Set objSysInfo = CreateObject("ADSystemInfo")
    objSysInfo.RefreshSchemaCache
    qQuery = "LDAP://" & objSysInfo.UserName
    Set objUser = GetObject(qQuery)
    
    'Variablen mit ausgelesenen AD_Attributen füllen
    Firma = objUser.company                                                    wird nicht ausgelesen
    Abteilung = objUser.department                                          wird nicht ausgelesen
    Name = objUser.firstname & " " & objUser.lastname            wird ausgelesen
    Phone = objUser.TelephoneNumber                                    wird nicht ausgelesen
    Fax = objUser.facsimileTelephoneNumber                           wird nicht ausgelesen
    EMail = objUser.mail                                                            wird ausgelesen
    WWW = objUser.wwwHomepage                                          wird nicht ausgelesen
    Position = objUser.Title                                                       wird nicht ausgelesen
    Initialen = objUser.initales                                                   wird nicht ausgelesen
    
    subEinfügen "txtAbteilung", Abteilung
    subEinfügen "txtTel", "tel: " & Phone
    subEinfügen "txtName", Name
    subEinfügen "txtWeb", WWW
    subEinfügen "txtUnterschrift", Name
    subEinfügen "txtUnterschriftAbteilung", Abteilung
    subEinfügen "txtEmail", EMail
    subEinfügen "txtAdresse", Adressat
End If


 
activedocumentc.Bookmarks("Kürzel").Range.InsertAfter short 'objUser.TelephoneNumberm ' Damit kann man sich die Verwendung wdgoto .. sparen...

...

...

...

    
End Sub

 

Ich verstehe nicht, da die Werte im AD eigentlich gefüllt sind, was er ausliest. evtl gibts noch einen anderen Ort, der hier hergenommen wird...

Ausserdem sind die Namen in den AD-Eigenschaften auch anders s. http://www.selfadsi.de/user-attributes.htm (Danke Sunny für die Seite)

Vielen dank für Eurre hilfe

bearbeitet 7. Oktober 2013 von redryder

[Sunny61 806]

Ich hab das Script zu 99% von dir übernommen, funktioniert und liefert Werte. Einzig die Initialien waren bei dir nicht korrekt:

Initialen = objUser.initials

Ein Error Resume Next ist kontraproduktiv, so siehst Du keine Fehler. Der von dir gep. Code ist in VBA erstellt? Wenn ja, dann kopiere diesen Code in ein Modul, speichern und kompilieren. Jetzt in die Funktion klicken und F8 drücken. Jetzt kannst Du mit F8 Zeile für Zeile weiter gehen und siehst nach der Zeile immer ob Werte in der vorherigen Variablen eingetragen wurden.

 

Public Function MeinTest()
    
    Dim user As String, short As String
    Dim qQuery As String, objSysInfo As Object, objUser As Object
    Dim Firma As String, strName As String, EMail As String, Phone As String
    Dim Fax As String, WWW As String, Position As String, Abteilung As String, Initialen As String


    'Active Directory Informationen des angemeldeten Users abrufen
    Set objSysInfo = CreateObject("ADSystemInfo")
    objSysInfo.RefreshSchemaCache
    qQuery = "LDAP://" & objSysInfo.UserName
    Set objUser = GetObject(qQuery)
    
    'Variablen mit ausgelesenen AD_Attributen füllen
    Firma = objUser.company
    Abteilung = objUser.department
    strName = objUser.firstname & " " & objUser.lastname
    Phone = objUser.TelephoneNumber
    Fax = objUser.facsimileTelephoneNumber
    EMail = objUser.mail
    WWW = objUser.wwwHomepage
    Position = objUser.Title
    Initialen = objUser.initials
    
End Function

Insbesonders die Variablendeklaration ist wichtig, gewöhn dir das an, ansonsten holt dich das später ein. In einem solchen VBA-Modul in den sog. Modul Kopf immer ein Option Explicit einfügen und den Code kompilieren, jetzt siehst Du schön die fehlenden Deklarationen.

bearbeitet 7. Oktober 2013 von Sunny61

[redryder 10]

Hi Sunny,

vielen Dank für Diene Antwort.

Ich habe mir den Code "zusammengebastelt" aus Anleitungen aus dem Netz. Das mit der Deklaration hab ich mir schon gedacht. So wie ichs gemacht hab, hätt ichs glaub ich auch lassen können. Wird ja nur der Name angelegt.

Glaub mein VBA Lehrer hat mal gesagt, dass jede Variable als Variant (universal) deklariert wird und jede Menge Speicher braucht.

In sofern werde ich den resume  raus tun und die Variablen deklarieren.

Ich berichte dann, ob es geklappt hat.

Wo hast Du denn die Werte eingetragen? Schon in der Domänenverwealtung (Eigenschaften eines User-Objektes) - oder?

Ich frage nur deshalb, weil ich ja die Eigenschaften belegt hab aber er nix liefert.

Bei den initialen ist mir aufgefallen, dass im AD "js" steht und in den Benutzerinfos von Office "JS," was er mir auch liefert.???

Danke bis gleich

Hi Sunny,

so ich hab Deinen Rat mal befolgt. Variablen deklariert, Option expicit eingefügt und das ganze mal laufen alssen.#

Leider gleiches Problem wie vorher. Wie in meinem Startpost liefert er mir die meisten Werte nicht. :-(

 

Code sieht jetzt folgendermaßen aus:

 

Option Explicit

Private Sub Document_New()
'On Error Resume Next
Dim user As String, short As String, objSysInfo As Object
Dim qQuery As String, objUser As Object
Dim Firma As String, Name As String, EMail As String, Phone As String, Fax As String, WWW As String, Position As String, Abteilung As String
Dim Initialen As String, adoc As Document, x As Integer, i As Integer, box As String
MsgBox "halt AD prüfen"
If ThisDocument.Name = "Melzer-Vorlage-dt.dot" Or ThisDocument.Name = "Vorlage-en.dot" Or ThisDocument.Name = "Vorlage_neu_AD.dot" And _
ThisDocument.Path = "\\primtx200\dokumente\" Or ThisDocument.Path = "\\primtx200\dokumente\verkauf\" Or _
ThisDocument.Path = "\\primtx200\einkauf\" Or ThisDocument.Path = "\\sr-file01\home\user\Eigene Dateien\Briefvorlage" Then
    'Active Directory Informationen des angemeldeten Users abrufen
    Set objSysInfo = CreateObject("ADSystemInfo")
    objSysInfo.RefreshSchemaCache
    qQuery = "LDAP://" & objSysInfo.UserName
    Set objUser = GetObject(qQuery)
    
    'Variablen mit ausgelesenen AD_Attributen füllen
    Firma = objUser.company
    Abteilung = objUser.department
    Name = objUser.firstname & " " & objUser.lastname
    Phone = objUser.TelephoneNumber
    Fax = objUser.facsimileTelephoneNumber
    EMail = objUser.mail
    WWW = objUser.wwwHomepage
    Position = objUser.Title
    Initialen = objUser.initials
    
  
    subEinfügen "txtAbteilung", Abteilung
    subEinfügen "txtTel", "tel: " & Phone
    subEinfügen "txtName", Name
    subEinfügen "txtWeb", WWW
    subEinfügen "txtUnterschrift", Name
    subEinfügen "txtUnterschriftAbteilung", Abteilung
    subEinfügen "txtEmail", EMail
    'subEinfügen "txtAdresse", Adressat
End If

ActiveDocument.Bookmarks("Kürzel").Range.InsertAfter short 'objUser.TelephoneNumberm   ' Damit kann man sich die Verwendung wdgoto .. sparen...
MsgBox short
    
End Sub

bearbeitet 7. Oktober 2013 von redryder

[Sunny61 806]

Name as String ist zwar OK, aber Name als Variable oder Bezeichnung ist immer schlecht. Ich hatte strName as String im Code stehen. Der Vorteil liegt auf der Hand, man sieht sofort es ist ein String. Zusätzlich vermeidet man damit das Wort Name.

 

Aktualisiere deinen Code wie folgt:

    Set objUser = GetObject(qQuery)
    Debug.Print qQuery

Was wird im Direktbereich ausgegeben? Stimmt das dort ausgegebene? STRG + G drücken, schon siehst Du den Direktbereich. Hast Du mehrere DCs im Einsatz? Wenn ja, funktioniert die Replizierung zwischen den DCs einwandfrei?

 

Kommentiere auch mal dies hier aus: objSysInfo.RefreshSchemaCache

Das muß auch ohne diese Zeile funktionieren.

 

BTW: Ich würde das so nicht direkt in Word ausführen lassen, lieber als Loginscript laufen lassen und in die Registry eintragen. In Word dann bei Bedarf auslesen.

[redryder 10]

Hi,

ich habe die Zeile objSysInfo.RefreshSchemaCache auskommentiert. Funktioniert auch ohne.

 

Wir haben 2 DC's im Einsatz. Replizierung funktioniert.

Im Direktbereich wird folgendes ausgegeben: LDAP://CN=Schwarz Jörg,OU=extern_e-mail,OU=Nutzer,OU=Melzer,DC=melzer,DC=local

Im Vergleich zur Domänenansicht stimmt das so.

Deinem btw zur Folge kann man die AD-Werte in die Reg eintragen? Wie geht das denn? Kannst Du mir da ne Hilfestellung geben?

Vielen Dank

Hi, ich nochmal.

Ich habe im falschen User nach gesehen. Wenn ich den richtigen User hernehme, dann gehts. Hatte im Kontakt geschaut. Den kann er natürlich nicht hernehmen......

Sorry, aber dafür habe ich ja wieder etwas weiter gelernt ;-) ... Wozu doch manche Fehler gut sind ggg

Über die Mgl, das in die Reg zu schrieben bin ich trotzdem noch brennend interessiert.

 

Schönen Feierabend..

[Sunny61 806]

Geht doch, freut mich für Dich und Danke für die Rückmeldung. ;)

 

Registry benutzen ist in VBA sehr einfach. Diese Links sollten helfen:

http://www.herber.de/mailing/Registry-Eintraege_schreiben_lesen_loeschen.htm

http://www.vbarchiv.net/tipps/tipp_907-registry-lesen-und-schreiben-ohne-api.html

 

Mein Favorit ist der erste Link. ;)