I was working for a company with offices all over Europe and they wanted to have a word template that included the Active Directory data (name, title, street address etc)  when a new document was created.

This is how I did it… Sorry for using Word 2003, but that was what they were running at the time.

Open up word and create a new file and save it as a .dot template. For me it looked something like this with a header and a footer.

Go to Tools -> Macro -> Macros (Alt+F8). Choose a name called AutoNew and press Create. It has to be AutoNew because then it will automatically be run when a new document is created [Reference].

Now cut’n’paste the following Macro. It will get the date and the following Active Directory attributes:

• givenName
• sn
• title
• streetAddress
• postalCode
• l (city)

Option Explicit

Sub AutoNew()
 With ActiveDocument.Bookmarks("MyDate").Range
 .InsertBefore Format(Date, "dd mmmm yyyy")
 End With
 With ActiveDocument.Bookmarks("MygivenName").Range
 .InsertBefore GetgivenName
 End With
 With ActiveDocument.Bookmarks("Mysn").Range
 .InsertBefore Getsn
 End With
 With ActiveDocument.Bookmarks("MyTitle").Range
 .InsertBefore GetTitle
 End With
 With ActiveDocument.Bookmarks("MystreetAddress").Range
 .InsertBefore GetstreetAddress
 End With
 With ActiveDocument.Bookmarks("MypostalCode").Range
 .InsertBefore GetpostalCode
 End With
 With ActiveDocument.Bookmarks("Myl").Range
 .InsertBefore Getl
 End With
End Sub

Function GetgivenName() As String
Dim objSysinfo As Object
Dim objUser As Object

Dim strUser As String 'Distinguished Name

Set objSysinfo = CreateObject("ADSystemInfo")
strUser = objSysinfo.UserName
Set objUser = GetObject("LDAP://" & strUser)

GetgivenName = objUser.get("givenName")

End Function

Function Getsn() As String
Dim objSysinfo As Object
Dim objUser As Object

Dim strUser As String 'Distinguished Name

Set objSysinfo = CreateObject("ADSystemInfo")
strUser = objSysinfo.UserName
Set objUser = GetObject("LDAP://" & strUser)

Getsn = objUser.get("sn")

End Function

Function GetTitle() As String
Dim objSysinfo As Object
Dim objUser As Object

Dim strUser As String 'Distinguished Name

Set objSysinfo = CreateObject("ADSystemInfo")
strUser = objSysinfo.UserName
Set objUser = GetObject("LDAP://" & strUser)

GetTitle = objUser.get("Title")

End Function

Function GetstreetAddress() As String
Dim objSysinfo As Object
Dim objUser As Object

Dim strUser As String 'Distinguished Name

Set objSysinfo = CreateObject("ADSystemInfo")
strUser = objSysinfo.UserName
Set objUser = GetObject("LDAP://" & strUser)

GetstreetAddress = objUser.get("StreetAddress")

End Function

Function GetpostalCode() As String
Dim objSysinfo As Object
Dim objUser As Object

Dim strUser As String 'Distinguished Name

Set objSysinfo = CreateObject("ADSystemInfo")
strUser = objSysinfo.UserName
Set objUser = GetObject("LDAP://" & strUser)

GetpostalCode = objUser.get("postalCode")

End Function

Function Getl() As String
Dim objSysinfo As Object
Dim objUser As Object

Dim strUser As String 'Distinguished Name

Set objSysinfo = CreateObject("ADSystemInfo")
strUser = objSysinfo.UserName
Set objUser = GetObject("LDAP://" & strUser)

Getl = objUser.get("l")

End Function

It uses bookmarks (more explained here where I got this idea) which means that the document will contain bookmarks and this is where it will import the data it gets from Active Directory.

Save/close the Macro and go back to the template.

At the specific fields <date>, <firstname>, <lastname> etc, remove this variable and instead, choose Insert -> Bookmark. Put the bookmark variables above (beginning with My*, also marked in red). You won’t see anything in the document but this is where the template will insert the data.

Save the template and create a new document using this template. It should get the data from Active Directory.

Please comment if you find this article useful.