Office:Word2010 Benutzerdaten aus ActiveDirectory verwenden
Aus znilwiki
*** Am 16.06.2011 überarbeitet - Ihr findet am Ende nun auch ein Beispiel das mit Suchen & Ersetzen arbeitet statt mit Formularfeldern ***
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.
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.
Vorher
Nacher
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.
Wir fügen ein solches Feld ein über
Ribbon Einfügen -- Schnellbausteine -- Feld...
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
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
Erläuterungen zum VBA Makro
Wir definieren zunächst sauber alle verwendeten Variablen:
' 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
...
Und holen uns unser ActiveDirectory Benutzerobjekt:
' 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)
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.
' Nachdem wir Zeiger haben füllen wir unserer Variablen
dvVorname = objBenutzer.givenName
dvInitialen = objBenutzer.initials
dvNachname = objBenutzer.sn
...
Im Anschluss schreiben wir die Werte in die DocVariablen
' 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
Ganz am Schluss müssen wir Word noch dazu bringen, den Inhalt der Felder zu aktualisieren:
' und zum Schluss die Werte aller Felder einmal aktualisieren (damit die neuen Werte auch sofort angezeigt werden)
ActiveDocument.Fields.Update
und das war schon alles
VBA Makro Kurzversion
Wenn Ihr euch den Zwischenschritt mit den Variablen sparen wollt, es geht auch direkt:
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
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.
Man schreibt in den Text z.B. ein "xxxVORNAMExxx" und lässt es dann durch im AD ermittelten Vornamen ersetzen.
Das nachfolgende Beispiel arbeitet so - und als Leckerchen ersetzt es auch den Text in Kopf- und Fußzeilen etc.
Die verwendeten Schlüsselwörter findet ihr im Quelltext,
strReplacementText(1) = "xLNx"
legt z.B. fest das überall im Text xLNx durch den Nachnamen ersetzt wird (siehe jeweils Kommentar)
Download: AD_Data_and_Replace_Text.txt
' #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
Kommentare
Loading comments...