Top-Themen

AppleEntwicklungHardwareInternetLinuxMicrosoftMultimediaNetzwerkeOff TopicSicherheitSonstige SystemeVirtualisierungWeiterbildungZusammenarbeit

Aktuelle Themen

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

Word Vorlage - Daten aus Active Directory ziehen

Frage Entwicklung VB for Applications

Mitglied: owner123

owner123 (Level 1) - Jetzt verbinden

30.05.2007, aktualisiert 15.08.2008, 17895 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 ..
Neuester Wissensbeitrag
Humor (lol)

Linkliste für Adventskalender

(3)

Information von nikoatit zum Thema Humor (lol) ...

Ähnliche Inhalte
Windows Server
gelöst Active Directory File Extension - Associated Program (11)

Frage von adm2015 zum Thema Windows Server ...

Windows 8
gelöst Active Directory Default User.v2 Profile - Windows 8.1 Apps Error (4)

Frage von adm2015 zum Thema Windows 8 ...

Windows Server
Active Directory sinnvoll für kleine Firma (15)

Frage von WolfPeano zum Thema Windows Server ...

Windows Server
gelöst Verschlüsselungsmethode Active-Directory Domänen Usern (4)

Frage von User79 zum Thema Windows Server ...

Heiß diskutierte Inhalte
Router & Routing
gelöst Ipv4 mieten (22)

Frage von homermg zum Thema Router & Routing ...

Windows Server
DHCP Server switchen (20)

Frage von M.Marz zum Thema Windows Server ...

Exchange Server
gelöst Exchange 2010 Berechtigungen wiederherstellen (20)

Frage von semperf1delis zum Thema Exchange Server ...

Hardware
gelöst Negative Erfahrungen LAN-Karten (19)

Frage von MegaGiga zum Thema Hardware ...