Top-Themen

Aktuelle Themen (A bis Z)

Administrator.de FeedbackApache ServerAppleAssemblerAudioAusbildungAuslandBackupBasicBatch & ShellBenchmarksBibliotheken & ToolkitsBlogsCloud-DiensteClusterCMSCPU, RAM, MainboardsCSSC und C++DatenbankenDatenschutzDebianDigitiales FernsehenDNSDrucker und ScannerDSL, VDSLE-BooksE-BusinessE-MailEntwicklungErkennung und -AbwehrExchange ServerFestplatten, SSD, RaidFirewallFlatratesGoogle AndroidGrafikGrafikkarten & MonitoreGroupwareHardwareHosting & HousingHTMLHumor (lol)Hyper-VIconsIDE & EditorenInformationsdiensteInstallationInstant MessagingInternetInternet DomäneniOSISDN & AnaloganschlüsseiTunesJavaJavaScriptKiXtartKVMLAN, WAN, WirelessLinuxLinux DesktopLinux NetzwerkLinux ToolsLinux UserverwaltungLizenzierungMac OS XMicrosoftMicrosoft OfficeMikroTik RouterOSMonitoringMultimediaMultimedia & ZubehörNetzwerkeNetzwerkgrundlagenNetzwerkmanagementNetzwerkprotokolleNotebook & ZubehörNovell NetwareOff TopicOpenOffice, LibreOfficeOutlook & MailPapierkorbPascal und DelphiPeripheriegerätePerlPHPPythonRechtliche FragenRedHat, CentOS, FedoraRouter & RoutingSambaSAN, NAS, DASSchriftartenSchulung & TrainingSEOServerServer-HardwareSicherheitSicherheits-ToolsSicherheitsgrundlagenSolarisSonstige SystemeSoziale NetzwerkeSpeicherkartenStudentenjobs & PraktikumSuche ProjektpartnerSuseSwitche und HubsTipps & TricksTK-Netze & GeräteUbuntuUMTS, EDGE & GPRSUtilitiesVB for ApplicationsVerschlüsselung & ZertifikateVideo & StreamingViren und TrojanerVirtualisierungVisual StudioVmwareVoice over IPWebbrowserWebentwicklungWeiterbildungWindows 7Windows 8Windows 10Windows InstallationWindows MobileWindows NetzwerkWindows ServerWindows SystemdateienWindows ToolsWindows UpdateWindows UserverwaltungWindows VistaWindows XPXenserverXMLZusammenarbeit

Frage Entwicklung VB for Applications

Word Vorlage - Daten aus Active Directory ziehen

Mitglied: owner123

owner123 (Level 1) - Jetzt verbinden

30.05.2007, aktualisiert 15.08.2008, 18546 Aufrufe, 3 Kommentare

Hallo,

meine Frage: Wie kann man per VBA in einem Worddokument die AD Daten auslesen. Es soll somit eine Vorlage für User geschaffen werden.
Es gab schon einige Threads, aber bisher nie eine funktionierende Lösung.

Wir arbeiten mit Office03 und Windows Server 2003. Betriebssysteme sind 2000 und hauptsächlich XP.

Alter, nicht funktionierender Code:
01.
'######################################################  
02.
'active directory auslesen  
03.
' AnbindungDomain  
04.
If Templates(I).CustomDocumentProperties("AnbindungDomain") = True Then  
05.
 
06.
Dim objSystemInfo As Object  
07.
Dim objUser As Object  
08.
 
09.
Set objSystemInfo = CreateObject("ADSystemInfo")  
10.
Set objUser = GetObject("LDAP://" & objSystemInfo.UserName)  
11.
 
12.
'Anmeldename = samAccountName  
13.
If ActiveDocument.Bookmarks.Exists("AbsenderuserPrincipalName") = True Then  
14.
Selection.GoTo what:=wdGoToBookmark, Name:="AbsenderuserPrincipalName"  
15.
Selection.TypeText objUser.samAccountName  
16.
End If  
17.
 
18.
'Vorname  
19.
If ActiveDocument.Bookmarks.Exists("AbsendergivenName") = True Then  
20.
Selection.GoTo what:=wdGoToBookmark, Name:="AbsendergivenName"  
21.
Selection.TypeText objUser.FirstName  
22.
End If  
23.
 
24.
'Nachname  
25.
If ActiveDocument.Bookmarks.Exists("Absendersn") = True Then  
26.
Selection.GoTo what:=wdGoToBookmark, Name:="Absendersn"  
27.
Selection.TypeText objUser.sn  
28.
End If  
29.
 
30.
'Telefon = telephoneNumber  
31.
If ActiveDocument.Bookmarks.Exists("AbsendertelephoneNumber") = True Then  
32.
Selection.GoTo what:=wdGoToBookmark, Name:="AbsendertelephoneNumber"  
33.
Selection.TypeText objUser.telephoneNumber  
34.
End If  
35.
 
36.
'BüroFax = facsimileTelephoneNumber  
37.
If ActiveDocument.Bookmarks.Exists("AbsenderfacsimileTelephoneNumber") = True Then  
38.
Selection.GoTo what:=wdGoToBookmark, Name:="AbsenderfacsimileTelephoneNumber"  
39.
Selection.TypeText objUser.facsimileTelephoneNumber  
40.
End If  
41.
 
42.
'Mail  
43.
If ActiveDocument.Bookmarks.Exists("Absendermail") = True Then  
44.
Selection.GoTo what:=wdGoToBookmark, Name:="Absendermail"  
45.
Selection.TypeText objUser.EmailAddress  
46.
End If  
47.
 
48.
'Title = Absendertitle  
49.
If ActiveDocument.Bookmarks.Exists("Absendertitle") = True Then  
50.
Selection.GoTo what:=wdGoToBookmark, Name:="Absendertitle"  
51.
Selection.TypeText objUser.Title  
52.
End If  
53.
 
54.
'Abteilung = Absenderdepartment  
55.
If ActiveDocument.Bookmarks.Exists("Absenderdepartment") = True Then  
56.
Selection.GoTo what:=wdGoToBookmark, Name:="Absenderdepartment"  
57.
Selection.TypeText objUser.Department  
58.
End If  
59.
 
60.
'Standort = physicalDeliveryOfficeName  
61.
If ActiveDocument.Bookmarks.Exists("AbsenderphysicalDeliveryOfficeName") = True Then  
62.
Selection.GoTo what:=wdGoToBookmark, Name:="AbsenderphysicalDeliveryOfficeName"  
63.
Selection.TypeText objUser.physicalDeliveryOfficeName  
64.
End If  
65.
 
66.
'Firma = company  
67.
If ActiveDocument.Bookmarks.Exists("Absendercompany") = True Then  
68.
Selection.GoTo what:=wdGoToBookmark, Name:="Absendercompany"  
69.
Selection.TypeText objUser.company  
70.
End If  
71.
 
72.
' Strasse = streetAddress  
73.
If ActiveDocument.Bookmarks.Exists("AbsenderstreetAddress") = True Then  
74.
Selection.GoTo what:=wdGoToBookmark, Name:="AbsenderstreetAddress"  
75.
Selection.TypeText objUser.streetAddress  
76.
End If  
77.
 
78.
'PLZ = postalCode  
79.
If ActiveDocument.Bookmarks.Exists("AbsenderpostalCode") = True Then  
80.
Selection.GoTo what:=wdGoToBookmark, Name:="AbsenderpostalCode"  
81.
Selection.TypeText objUser.postalCode  
82.
End If  
83.
 
84.
'Ort = l  
85.
If ActiveDocument.Bookmarks.Exists("Absenderl") = True Then  
86.
Selection.GoTo what:=wdGoToBookmark, Name:="Absenderl"  
87.
Selection.TypeText objUser.l  
88.
End If  
89.
 
90.
'Bundesland = st  
91.
If ActiveDocument.Bookmarks.Exists("Absenderst") = True Then  
92.
Selection.GoTo what:=wdGoToBookmark, Name:="Absenderst"  
93.
Selection.TypeText objUser.st  
94.
End If  
95.
 
96.
'Land = countryCode  
97.
If ActiveDocument.Bookmarks.Exists("AbsendercountryCode") = True Then  
98.
Selection.GoTo what:=wdGoToBookmark, Name:="AbsendercountryCode"  
99.
Selection.TypeText objUser.countryCode  
100.
End If  
101.
 
102.
'Mobiletelefon = mobile  
103.
If ActiveDocument.Bookmarks.Exists("Absendermobile") = True Then  
104.
Selection.GoTo what:=wdGoToBookmark, Name:="Absendermobile"  
105.
Selection.TypeText objUser.mobile  
106.
End If  
107.
 
108.
'Vorgesetzter = manager  
109.
If ActiveDocument.Bookmarks.Exists("Absendermanager") = True Then  
110.
Selection.GoTo what:=wdGoToBookmark, Name:="Absendermanager"  
111.
Selection.TypeText objUser.Manager  
112.
End If  
113.
 
114.
'Webadresse = wwwHomePage  
115.
If ActiveDocument.Bookmarks.Exists("AbsenderwwwHomePage") = True Then  
116.
Selection.GoTo what:=wdGoToBookmark, Name:="AbsenderwwwHomePage"  
117.
Selection.TypeText objUser.wwwHomePage  
118.
End If  
119.
 
120.
Set objUser = Nothing  
121.
Set objSystemInfo = Nothing  
122.
Else  
123.
 
124.
'Application.UserInitials  
125.
'Application.UserName  
126.
End If 
01.
Sub testen() 
02.
'' testen Makro 
03.
' Makro erstellt am 27.07.2005 von testen 
04.
05.
Dim objADInfo As Object 
06.
Dim objLogonName As Object 
07.
Dim objPhone As Object 
08.
Dim objMail As Object 
09.
Dim strMail As String 
10.
Dim strTelephoneNumer As String 
11.
Dim strUserName As String 
12.
Dim strUserInitials As String 
13.
 
14.
Set objADInfo = CreateObject("ADSystemInfo") 
15.
Set objLogonName = GetObject("LDAP://" & objADInfo.UserName) 
16.
 
17.
strUserName = objLogonName.firstname & " " & objLogonName.lastname 
18.
strTelephoneNumber = objtelephoneNumber 
19.
strMail = objMail 
20.
 
21.
Application.UserName = strUserName 
22.
Application.UserInitials = strTelephoneNumber 
23.
Application.UserAddress = strMail 
24.
 
25.
End Sub
01.
Set objSystemInfo = CreateObject("ADSystemInfo")  
02.
Set objUser = GetObject("LDAP://" & objSystemInfo.UserName)  
03.
ActiveDocument.BookMarks("txtName").Range.Text = objUser.LastName  
04.
ActiveDocument.BookMarks("txtVorname").Range.Text = objUser.FirstName  
05.
ActiveDocument.BookMarks("txtTelefon").Range.Text = objUser.TelephoneNumber  
06.
ActiveDocument.BookMarks("txtMail").Range.Text = objUser.EmailAddress  
07.
ActiveDocument.BookMarks("txtAbteilung").Range.Text = objUser.Department
Ich hoffe jemand weiss Rat bzw. kann es mal an seinem System testen.
Gruß
Update:
30.05.2007 00:19 Uhr
Ich habe den Quellcode in die Codeblöcke gepackt. Macht das Ganz einfach übersichtlicher...

Dani
(Moderator)
Mitglied: quaestor
19.02.2008 um 19:06 Uhr
Gibt es hierzu eine Lösung?
Wir haben das gleich Problem bei uns.
Ein Hinweis auf ne Quelle würde mir schon genügen.
Danke
Bitte warten ..
Mitglied: napperman
15.08.2008 um 08:55 Uhr
Ich hab irgendwo im Netz einen anderen Code gefunden. Den habe ich ein wenig umgebaut und als Makro
eingebunden. Das ganze habe ich Pfadabhängig gemacht, da ich nicht möchte, das die Vorlage überschrieben wird.
Außerdem ist das ein Makro dass beim öffnen automatisch läuft. Dies soll es aber nur an dieser Stelle. Hat der User seine Vorlage, soll er sie auf seinem Desktop oder sonstwo speichern:

Sub AutoOpen()

On Error Resume Next
Dim qQuery, objSysInfo, objuser
Dim firma, Name, EMail, Phone, Fax, web, position, Abteilung
If ThisDocument.Name = "Briefvorlage.doc" And _
ThisDocument.Path = "T:\Briefvorlage" _
Then
' Active Directory Informationen für den angemeldeten User lesen
Set objSysInfo = CreateObject("ADSystemInfo")
objSysInfo.RefreshSchemaCache
qQuery = "LDAP://" & objSysInfo.UserName
Set objuser = GetObject(qQuery)

'Variablen mit AD-Attributen füllen (es gibt da natürlich mehr Attribute FaxNumber usw.)
firma = objuser.company
Abteilung = objuser.physicalDeliveryOfficeName
Name = objuser.firstname & " " & objuser.lastname
Phone = objuser.TelephoneNumber
Fax = objuser.facsimileTelephoneNumber
EMail = objuser.mail
web = objuser.wwwHomePage
position = objuser.Title

smsEinfügen "smsAbteilung", Abteilung
smsEinfügen "smsTel", "tel: " & Phone
smsEinfügen "smsName", Name
smsEinfügen "smsweb", web
smsEinfügen "smsUnterschrift", Name
smsEinfügen "smsUnterschriftAbteilung", Abteilung
smsEinfügen "smsEmail", EMail
End If
End Sub


Public Sub smsEinfügen(Textmarke, Variable)
' Prozedur zum Einfügen des Wertes ("Variable") an der entsprechenden Textmarke
If ActiveDocument.Bookmarks.Exists(Textmarke) = True Then
Selection.GoTo What:=wdGoToBookmark, Name:=Textmarke
Selection.TypeText Variable
End If
End Sub
Bitte warten ..
Mitglied: SteKoLos
20.03.2013 um 21:16 Uhr
Hallo zusammen,

wir haben eine eingenständiges Addin unter http://www.ldap2doc.de erstellt.
Das Add-In Verbindet ganz einfach die Datenfelder aus dem Active Directoy mit Ihren Word Vorlagen.

Hier finden Sie auch unsere kostenlose Testversion!

Viele Grüße
SteKoLos
Bitte warten ..
Ähnliche Inhalte
Microsoft Office
Word 2010 Vorlage nach Word 2007?
Frage von QQR700Microsoft Office10 Kommentare

Hallo, ich habe in Word 2010 eine Vorlage erstellt und als .dotx Datei abgespeichert. Kann man diese Vorlage ohne ...

Microsoft Office
Word 2010 Vorlage
gelöst Frage von veniplexMicrosoft Office6 Kommentare

Hallo zusammen, ich verzweifel gerade Ich möchte in Word 2010 eine neue Vorlage erstellen, der Witz ist aber: Sobald ...

Windows Netzwerk
GPO- Word Vorlagen
Frage von Technology-LWindows Netzwerk2 Kommentare

Hallo Administratoren, eine kurze Frage bezüglich GPO's Ich habe aktuell eine Richtlinie für Word aktiviert, welche den Speicherort für ...

Microsoft Office
Vorlagen in Word 2010
Frage von klauser77Microsoft Office1 Kommentar

Hallo zusammen, Hallo zusammen, ich habe bei uns ein kleines Problem mit den Vorlagen in Word 2010. Ich möchte ...

Neue Wissensbeiträge
Router & Routing

PfSense als Addon auf QNAP

Information von magicteddy vor 12 StundenRouter & Routing2 Kommentare

Moin, für Spielereien eine ganz nette Idee aber ich fürchte das soetwas auch als echte Firewall genutzt wird: In ...

Datenschutz

Teamviewer kommt für IoT-Geräte wie den Raspberry Pi

Information von magicteddy vor 19 StundenDatenschutz

Moin, jetzt werden IoT Geräte endgültig zur Wanze? Anscheinend kann man auf einem Dashboard seine Geräte visualisieren Ich stelle ...

Microsoft

Letzte Updates für Win10 und Server2016 müssen bei Bedarf über den Update catalogue in den WSUS importiert werden!

Tipp von DerWoWusste vor 23 StundenMicrosoft1 Kommentar

automatisch kommt da nichts an im WSUS und auch nicht im SCCM. Siehe Hinweise zum Bezug der jeweils neuesten ...

Linux

Meltdown und Spectre: Linux Update

Information von Frank vor 3 TagenLinux

Meltdown (Variante 3 des Prozessorfehlers) Der Kernel 4.14.13 mit den Page-Table-Isolation-Code (PTI) ist nun für Fedora freigegeben worden. Er ...

Heiß diskutierte Inhalte
Netzwerkmanagement
Preis für Wartungsvertrag ok?
gelöst Frage von a-za-zNetzwerkmanagement22 Kommentare

Hallo! Mal ne Frage, weil ich mich mit dem akzeptablen Preis für einen Reaktionszeitvertrag nicht auskenne. Meine Firma hat ...

Windows Netzwerk
Ist ein Portforwarding auf einen PC ohne lauschendes Programm ein (großes) Sicherheitsproblem?
Frage von PluwimWindows Netzwerk13 Kommentare

Hallo zusammen, zur Fernwartung eines Rechners an einem anderen Ort nutze ich VNC. Da dieser Rechner einfach nur eine ...

Windows Server
Terminal Server 2016 erkennt Berechtigungen nicht
gelöst Frage von Thomas2Windows Server10 Kommentare

Hallo Administratoren, folgendes Problem stellt sich dar: Es gibt zwei Windows Server 2016, die als Terminal Server fungieren. Jetzt ...

Sonstige Systeme
7-zip: Programm frägt nach Passwort erst bei einzelnen Dateien
Frage von freeskierchrisSonstige Systeme7 Kommentare

Guten Morgen, ich habe ein Problem beim Arbeiten mit 7-zip: Wenn ich die einzelnen Dateien zu einem Archiv verpacke ...