Quelltext der Seite Office:Word2010 Benutzerdaten aus ActiveDirectory verwenden


[[Kategorie:Active_Directory]]
<p style="color:black; background-color:lightgrey">
<br>
'''*** Am 16.06.2011 überarbeitet - Ihr findet am Ende nun auch ein Beispiel das mit Suchen & Ersetzen arbeitet statt mit Formularfeldern ***<br>
<br>
</p>
{{Hinweis| Diese Anleitung ist für Word 2010. Das ganze funktioniert aber 1:1 ohne Änderungen auch unter Word 2013}}<br>
=Einleitung=

Dies ist ein Beispiel für die Abfrage des Active Directory aus Word heraus mittels Visual Basic für Applikationen (VBA).

Weiter unten findet Ihr das Beispieldokument zum selber testen. Die Beispiele funktionieren natürlich nur, wenn diese von einem Domänenbenutzer durchgeführt werden - auf einem lokalen Rechner gibt es kein Active Directory.

Hier einmal die Demo-Datei: [[Media:ActiveDirectory-Test.docm.zip]]

Auf den Bilder könnt Ihr sehen was wir machen wollen - ein Word-Dokument mit 2 Schaltflächen.<br>
Die erste Schaltfläche schreibt in alle Felder ein " - ", die zweite liest die AD-Daten des gerade angemeldeten Benutzers aus und trägt diese in die Felder ein.

<gallery>
Datei:Word-AD-Test1.gif|Vorher
Datei:Word-AD-Test2.gif|Nacher
</gallery>

----

==Word Dokument Vorbereiten==
===DocVariable einfügen===
Wir wollen mit VBA Werte im aktiven Dokument ändern. Da es am einfachsten ist habe ich mich für Formularfelder vom Typ '''''DocTariable''''' entschieden.<br>

Wir fügen ein solches Feld ein über

Ribbon '''''Einfügen''''' -- '''''Schnellbausteine''''' -- '''''Feld...'''''

[[Datei:DocVariable.gif]]

Unter "Neuer Name" geben wir dem Feld den Namen über den wir es dann von VBA aus ansprechen, hier z.B. Vorname.

----
===VBA Makro erstellen===

Nachdem wir alle gewünschten Felder eingefügt und formatiert haben öffnen wir die Visual Basic Konsole ( '''[ALT]+[F11]''' )

Hier fügen wir ein neues Modul ein (Modul1) und erstellen die Routine / das Makro:

====VBA Makro Langversion====

<syntaxhighlight lang="vb">
Sub ADTest()
 
' dv steht für DOCVARIABLE - das sind die Felder im eigentlichen Word-Dokument
Dim dvVorname               As String
Dim dvInitialen             As String
Dim dvNachname              As String
Dim dvAnzeigename           As String
Dim dvBeschreibung          As String
Dim dvBuero                 As String
Dim dvRufnummer             As String
Dim dvEmail                 As String
Dim dvWebseite              As String
Dim dvStrasse               As String
Dim dvPostfach              As String
Dim dvOrt                   As String
Dim dvBundesland            As String
Dim dvPostleitzahl          As String
Dim dvLand                  As String
Dim dvBenutzeranmeldename   As String
Dim dvRufnummernPrivat      As String
Dim dvRufnummernPager       As String
Dim dvRufnummernMobil       As String
Dim dvRufnummernFax         As String
Dim dvRufnummernIPTelefon   As String
Dim dvAnmerkungen           As String
Dim dvPosition              As String
Dim dvAbteilung             As String
Dim dvFirma                 As String
Dim dvVorgesetzter          As String
Dim dvMitarbeiter           As String

'Variablen für AD-Abfrage
Dim varQuery As String
Dim objSystemInfo As Object
Dim objBenutzer As Object

' Active Directory Informationen des angemeldeten Benutzers lesen
Set objSystemInfo = CreateObject("ADSystemInfo")
varQuery = "LDAP://" & objSystemInfo.UserName
' mit Nachfolgender Zeile haben wir einen Zeiger auf das AD-Objekt des Benutzers
' damit können wir alle AD-Felder abfragen
Set objBenutzer = GetObject(varQuery)

' Nachdem wir Zeiger haben füllen wir unserer Variablen
dvVorname = objBenutzer.givenName
dvInitialen = objBenutzer.initials
dvNachname = objBenutzer.sn
dvAnzeigename = objBenutzer.DisplayName
dvBeschreibung = objBenutzer.Description
dvBuero = objBenutzer.PhysicalDeliveryOfficeName
dvRufnummer = objBenutzer.telephoneNumber
dvEmail = objBenutzer.mail
dvWebseite = objBenutzer.wWWHomepage
dvStrasse = objBenutzer.streetAddress
dvPostfach = objBenutzer.postOfficeBox
dvOrt = objBenutzer.l
dvBundesland = objBenutzer.st
dvPostleitzahl = objBenutzer.postalCode
dvLand = objBenutzer.CO
dvBenutzeranmeldename = objBenutzer.sAMAccountName
dvRufnummernPrivat = objBenutzer.homePhone
dvRufnummernPager = objBenutzer.pager
dvRufnummernMobil = objBenutzer.mobile
dvRufnummernFax = objBenutzer.facsimileTelephoneNumber
dvRufnummernIPTelefon = objBenutzer.ipPhone
dvAnmerkungen = objBenutzer.info
dvPosition = objBenutzer.Title
dvAbteilung = objBenutzer.department
dvFirma = objBenutzer.company
dvVorgesetzter = objBenutzer.manager

' nun füllen wir die DOCVARIABLEN im Dokument mit diesen Werten
ActiveDocument.Variables("Vorname").Value = dvVorname
ActiveDocument.Variables("Initialen").Value = dvInitialen
ActiveDocument.Variables("Nachname").Value = dvNachname
ActiveDocument.Variables("Anzeigename").Value = dvAnzeigename
ActiveDocument.Variables("Beschreibung").Value = dvBeschreibung
ActiveDocument.Variables("Buero").Value = dvBuero
ActiveDocument.Variables("Rufnummer").Value = dvRufnummer
ActiveDocument.Variables("Email").Value = dvEmail
ActiveDocument.Variables("Webseite").Value = dvWebseite
ActiveDocument.Variables("Strasse").Value = dvStrasse
ActiveDocument.Variables("Postfach").Value = dvPostfach
ActiveDocument.Variables("Ort").Value = dvOrt
ActiveDocument.Variables("Bundesland").Value = dvBundesland
ActiveDocument.Variables("Postleitzahl").Value = dvPostleitzahl
ActiveDocument.Variables("Land").Value = dvLand
ActiveDocument.Variables("Benutzeranmeldename").Value = dvBenutzeranmeldename
ActiveDocument.Variables("RufnummernPrivat").Value = dvRufnummernPrivat
ActiveDocument.Variables("RufnummernPager").Value = dvRufnummernPager
ActiveDocument.Variables("RufnummernMobil").Value = dvRufnummernMobil
ActiveDocument.Variables("RufnummernFax").Value = dvRufnummernFax
ActiveDocument.Variables("RufnummernIPTelefon").Value = dvRufnummernIPTelefon
ActiveDocument.Variables("Anmerkungen").Value = dvAnmerkungen
ActiveDocument.Variables("Position").Value = dvPosition
ActiveDocument.Variables("Abteilung").Value = dvAbteilung
ActiveDocument.Variables("Firma").Value = dvFirma
ActiveDocument.Variables("Vorgesetzter").Value = dvVorgesetzter

' und zum Schluss die Werte aller Felder einmal aktualisieren (damit die neuen Werte auch sofort angezeigt werden)
ActiveDocument.Fields.Update

End Sub
 

</syntaxhighlight>

====Erläuterungen zum VBA Makro====
Wir definieren zunächst sauber alle verwendeten Variablen:
<syntaxhighlight lang="vb">
' dv steht für DOCVARIABLE - das sind die Felder im eigentlichen Word-Dokument
Dim dvVorname               As String
Dim dvInitialen             As String
Dim dvNachname              As String
...
</syntaxhighlight>
Und holen uns unser ActiveDirectory Benutzerobjekt:
<syntaxhighlight lang="vb">
' Active Directory Informationen des angemeldeten Benutzers lesen
Set objSystemInfo = CreateObject("ADSystemInfo")
varQuery = "LDAP://" & objSystemInfo.UserName
' mit Nachfolgender Zeile haben wir einen Zeiger auf das AD-Objekt des Benutzers
' damit können wir alle AD-Felder abfragen
Set objBenutzer = GetObject(varQuery)
</syntaxhighlight>
Danach füllen wir unsere Variablen - ja ja ich weis, das müssten wir nicht extra tun, wir könnten die Daten auch direkt nutzen. Das Makro hier dienst jedoch noch als vorlage für andere Projekte - und so habe ich dann schon mal alles für die Weiterverarbeitung.
<syntaxhighlight lang="vb">
' Nachdem wir Zeiger haben füllen wir unserer Variablen
dvVorname = objBenutzer.givenName
dvInitialen = objBenutzer.initials
dvNachname = objBenutzer.sn
...
</syntaxhighlight>

Im Anschluss schreiben wir die Werte in die '''''DocVariablen'''''
<syntaxhighlight lang="vb">
' nun füllen wir die DOCVARIABLEN im Dokument mit diesen Werten
ActiveDocument.Variables("Vorname").Value = dvVorname
ActiveDocument.Variables("Initialen").Value = dvInitialen
ActiveDocument.Variables("Nachname").Value = dvNachname
</syntaxhighlight>

Ganz am Schluss müssen wir Word noch dazu bringen, den Inhalt der Felder zu aktualisieren:
<syntaxhighlight lang="vb">
' und zum Schluss die Werte aller Felder einmal aktualisieren (damit die neuen Werte auch sofort angezeigt werden)
ActiveDocument.Fields.Update
</syntaxhighlight>
und das war schon alles

====VBA Makro Kurzversion====
Wenn Ihr euch den Zwischenschritt mit den Variablen sparen wollt, es geht auch direkt:
<syntaxhighlight lang="vb">
Sub ADTestKurz()
 
'Variablen für AD-Abfrage
 
Dim varQuery As String
Dim objSystemInfo As Object
Dim objBenutzer As Object
 
' Active Directory Informationen des angemeldeten Benutzers lesen
Set objSystemInfo = CreateObject("ADSystemInfo")
varQuery = "LDAP://" & objSystemInfo.UserName
' mit Nachfolgender Zeile haben wir einen Zeiger auf das AD-Objekt des Benutzers
' damit können wir alle AD-Felder abfragen
Set objBenutzer = GetObject(varQuery)
 
' nun füllen wir die DOCVARIABLEN im Dokument mit diesen Werten
ActiveDocument.Variables("Vorname").Value = objBenutzer.givenName
ActiveDocument.Variables("Initialen").Value = objBenutzer.initials
ActiveDocument.Variables("Nachname").Value = objBenutzer.sn
ActiveDocument.Variables("Anzeigename").Value = objBenutzer.DisplayName
ActiveDocument.Variables("Beschreibung").Value = objBenutzer.Description
ActiveDocument.Variables("Buero").Value = objBenutzer.PhysicalDeliveryOfficeName
ActiveDocument.Variables("Rufnummer").Value = objBenutzer.telephoneNumber
ActiveDocument.Variables("Email").Value = objBenutzer.mail
ActiveDocument.Variables("Webseite").Value = objBenutzer.wWWHomepage
ActiveDocument.Variables("Strasse").Value = objBenutzer.streetAddress
ActiveDocument.Variables("Postfach").Value = objBenutzer.postOfficeBox
ActiveDocument.Variables("Ort").Value = objBenutzer.l
ActiveDocument.Variables("Bundesland").Value =objBenutzer.st
ActiveDocument.Variables("Postleitzahl").Value = objBenutzer.postalCode
ActiveDocument.Variables("Land").Value = objBenutzer.CO
ActiveDocument.Variables("Benutzeranmeldename").Value = objBenutzer.sAMAccountName
ActiveDocument.Variables("RufnummernPrivat").Value = objBenutzer.homePhone
ActiveDocument.Variables("RufnummernPager").Value = objBenutzer.pager
ActiveDocument.Variables("RufnummernMobil").Value = objBenutzer.mobile
ActiveDocument.Variables("RufnummernFax").Value = objBenutzer.facsimileTelephoneNumber
ActiveDocument.Variables("RufnummernIPTelefon").Value = objBenutzer.ipPhone
ActiveDocument.Variables("Anmerkungen").Value = objBenutzer.info
ActiveDocument.Variables("Position").Value = objBenutzer.Title
ActiveDocument.Variables("Abteilung").Value = objBenutzer.department
ActiveDocument.Variables("Firma").Value = objBenutzer.company
ActiveDocument.Variables("Vorgesetzter").Value = objBenutzer.manager

' und zum Schluss die Werte aller Felder einmal aktualisieren (damit die neuen Werte auch sofort angezeigt werden)
ActiveDocument.Fields.Update
 
End Sub
</syntaxhighlight>

Nach Anfrage: Man müsste das auch auf die Abfrage der Stellverteter ausbauen können, die passenden Feldnamen finden sich hier:

 http://www.msxfaq.de/konzepte/stellvertreter.htm

----

=Suchen & Ersetzen=

Statt mit den DocVariablen kann auch mit Schlüsselwörtern gearbeitet werden.<br>
Man schreibt in den Text z.B. ein "xxxVORNAMExxx" und lässt es dann durch im AD ermittelten Vornamen ersetzen.<br>
Das nachfolgende Beispiel arbeitet so - und als Leckerchen ersetzt es auch den Text in Kopf- und Fußzeilen etc.<br>

Die verwendeten Schlüsselwörter findet ihr im Quelltext,
<syntaxhighlight lang="vb">
strReplacementText(1) = "xLNx"
</syntaxhighlight>
legt z.B. fest das überall im Text '''xLNx''' durch den Nachnamen ersetzt wird (siehe jeweils Kommentar)<br>
<br>
<br>
<big>'''Download: [[Media:AD_Data_and_Replace_Text.txt|AD_Data_and_Replace_Text.txt]]'''</big>
<br>
<br>
<syntaxhighlight lang="vb">
' #Subfunction#
'===============================================================================
'
' Name...........: AD_Data_and_Replace_Text()
' Description ...: Ruft die Daten des aktuellen Benutzers aus dem Active Directory ab und
'                  setzt diese in das Dokument ein. Dies geschieht über Suchen & Ersetzen,
'                  xLNx im Text des Dokumentes wird z.B. durch dem in AD hinterlegten
'                  Nachnamen ersetzt - egal wie oft im Dokument das Schlüsselwort vorkommt.
'                  Formatierungen bleiben dabei erhalten, das Schlüsselwort wird auch in
'                  der Kopf- und Fußzeile gefunden und ersetzt.
' Syntax.........: AD_Data_and_Replace_Text()
' Parameters ....: keine
' Return values .: keine
' Author ........: Bernhard Linz / Bernhard.Linz@datagroup.de / admin@znil.net
' Modified.......:
' Remarks .......:
' Related .......:
' Link ..........: http://znil.net (Bereich Office / Word)
'
Sub AD_Data_and_Replace_Text()
   '===============================================================================
   'In den nachfolgenden Variablen werden die Informationen aus dem Active Directory über den aktuellen Benutzer gespeichert.
   'In der strReplacementText wird der dazu passende Suchtext gespeichert. Das wir dafür 2 Arrays nehmen hat den Grund
   'das wir so für das Suchen & Ersetzen mit Schleifen arbeiten können - sonst wäre der Quelltext sehr lang geworden wobei
   'immer wieder das selbe wiederholt worden wäre.
   'Um das ganze zu Erweitern müssen also unten in den Variablenzuweisungen einfach die weiteren Felder fortlaufend hinzugefügt
   'werden - und hier oben die Gesamtanzahl angepasst werden. Da wir bei 0 anfangen zu zählen sind also 0 bis 25 = 26 insgesammt.
   'Also immer einen mehr als der letzte Eintrag
   Const AnzahlElemente                        As Integer = 26
   Dim strObject(AnzahlElemente)               As String
   Dim strReplacementText(AnzahlElemente)      As String
   
   '===============================================================================
   ' Allgemeine Variablen
   Dim Zaehler                                 As Integer
   Dim oStory                                  As Range
   
   '===============================================================================
   'Variablen für Active Directory-Abfrage
   Dim varQuery                                As String
   Dim objSystemInfo                           As Object
   Dim objBenutzer                             As Object
   
   '===============================================================================
   ' Active Directory Informationen des angemeldeten Benutzers lesen
   Set objSystemInfo = CreateObject("ADSystemInfo")
   varQuery = "LDAP://" & objSystemInfo.UserName
   ' mit Nachfolgender Zeile haben wir einen Zeiger auf das AD-Objekt des Benutzer's damit können wir alle AD-Felder abfragen
   Set objBenutzer = GetObject(varQuery)
   
   '===============================================================================
   'Setzen der Suchtexte
   '===============================================================================
   '0. First Name
       strObject(0) = objBenutzer.givenName
       strReplacementText(0) = "xFNx"
   '1. Last Name
       strObject(1) = objBenutzer.sn
       strReplacementText(1) = "xLNx"
   '2. Initialien
       strObject(2) = objBenutzer.initials
       strReplacementText(2) = "xINx"
   '3. User Logon Name
       strObject(3) = objBenutzer.sAMAccountName
       strReplacementText(3) = "xLogonNamex"
   '4. Display Name
       strObject(4) = objBenutzer.DisplayName
       strReplacementText(4) = "xDisplayNamex"
   '5. Description
       strObject(5) = objBenutzer.Description
       strReplacementText(5) = "xDescriptionx"
   '6. Job Title
       strObject(6) = objBenutzer.Title
       strReplacementText(6) = "xJobTitlex"
   '7. Department
       strObject(7) = objBenutzer.department
       strReplacementText(7) = "xDepartmentx"
   '8. Company
       strObject(8) = objBenutzer.company
       strReplacementText(8) = "xCompanyx"
   '9. Office
       strObject(9) = objBenutzer.PhysicalDeliveryOfficeName
       strReplacementText(9) = "xOfficex"
  '10. Telephone Number
       strObject(10) = objBenutzer.telephoneNumber
       strReplacementText(10) = "xTelOfficex"
  '11. Home Number
       strObject(11) = objBenutzer.homePhone
       strReplacementText(11) = "xTelHomex"
  '12. Mobile Number
       strObject(12) = objBenutzer.mobile
       strReplacementText(12) = "xTelMobilex"
  '13. Fax Number
       strObject(13) = objBenutzer.facsimileTelephoneNumber
       strReplacementText(13) = "xTelFAXx"
  '14. Pager Number
       strObject(14) = objBenutzer.pager
       strReplacementText(14) = "xTelPagerx"
  '15. Email
       strObject(15) = objBenutzer.mail
       strReplacementText(15) = "xEMAILx"
  '16. Web-Page
       strObject(16) = objBenutzer.wWWHomepage
       strReplacementText(16) = "xWWWx"
  '17. Street
       strObject(17) = objBenutzer.streetAddress
       strReplacementText(17) = "xSTREETx"
  '18. P.O. Box
       strObject(18) = objBenutzer.postOfficeBox
       strReplacementText(18) = "xPOx"
  '19. Zip
       strObject(19) = objBenutzer.postalCode
       strReplacementText(19) = "xZIPx"
  '20. City
       strObject(20) = objBenutzer.l
       strReplacementText(20) = "xCITYx"
  '21. State
       strObject(21) = objBenutzer.st
       strReplacementText(21) = "xSTATEx"
  '22. Country
       strObject(22) = objBenutzer.CO
       strReplacementText(22) = "xCOUNTRYx"
  '23. IP-Telephone
       strObject(23) = objBenutzer.ipPhone
       strReplacementText(23) = "xTelIPx"
  '24. Notes
       strObject(24) = objBenutzer.info
       strReplacementText(24) = "xNOTESx"
  '25. EmployeeID
       strObject(25) = objBenutzer.employeeID
       strReplacementText(25) = "xEmployeeIDx"
       
   '===============================================================================
   'Suchen und Ersetzen!
   '===============================================================================
   Application.ScreenUpdating = False
   For Zaehler = 0 To (AnzahlElemente - 1) Step 1
   'Einmal für jedes Schlüsselwort ....
       For Each oStory In ActiveDocument.StoryRanges
       'und noch einmal für jeden Dokumentenbereich
       'Sonst geht es nicht mit Kopf- und Fußzeile
           oStory.Find.ClearFormatting
           oStory.Find.Replacement.ClearFormatting
           With oStory.Find
               .Text = strReplacementText(Zaehler)
               .Replacement.Text = strObject(Zaehler)
               .Forward = True
               .Wrap = wdFindContinue
               .Format = False
               .MatchCase = True
               .MatchWholeWord = True
               .MatchWildcards = False
               .MatchSoundsLike = False
               .MatchAllWordForms = False
           End With
           oStory.Find.Execute Replace:=wdReplaceAll
           'Hauptbereich ist abgefrühstückt - nun die restlichen Bereiche
           While Not (oStory.NextStoryRange Is Nothing)
               Set oStory = oStory.NextStoryRange
               oStory.Find.ClearFormatting
               oStory.Find.Replacement.ClearFormatting
               With oStory.Find
                   .Text = strReplacementText(Zaehler)
                   .Replacement.Text = strObject(Zaehler)
                   .Forward = True
                   .Wrap = wdFindContinue
                   .Format = False
                   .MatchCase = True
                   .MatchWholeWord = True
                   .MatchWildcards = False
                   .MatchSoundsLike = False
                   .MatchAllWordForms = False
               End With
               oStory.Find.Execute Replace:=wdReplaceAll
           Wend
       Next
   Next Zaehler
   Application.ScreenUpdating = True
End Sub

</syntaxhighlight>
<br>
<br>
----

=Kommentare=
<comments />