If you’re an Active Directory admin sooner or later the question will come to you. We need automatic, customized signatures in Outlook for every user.

There are third party applications that do this and I understand Exchange can do this nowadays but when I wrote this script, it couldn’t and 3rd parties were too expensive or lacked features I wanted.

The fun thing about Outlook is that when you create a signature in it it scrambles your html and thus its layout. It will not keep its paws of it. The workaround is to create your own html file and point Outlook to it so it doesn’t have to save it itself.

We created a default signature in html with our logo and placeholders for phone, fax, cell number, etc. I put in [PHONE], [FAX], etc. in the placeholder. The script then pulls the info from the AD useraccount and replaces the placeholders. I used the AD logon script to do this.

Here’s how it goes when a user logs on:

  1. The default signature file is copied to the user’s computer.
  2. The user’s information is pulled from AD.
  3. The placeholders in the html signature file replaced by the info from the user account.
  4. Outlook is pointed to the signature files.

 

A strange thing to note is that Outlook signature files are actually set using Microsoft Word, which can act as Outlook’s e-mail editor.

Some users wanted a custom ‘tag line’ before their signature in e-mails so they wouldn’t have to type their names. I used the Notes field under the Telephone tab in the users’ account properties for this.

In my Domain Controller’s logon directory I made a directory called Signatures and placed all defaults (the html files and pictures) there. The script references them and the clients initially copy those files to customize them locally. As we are a Dutch organisation I had to account for multiple languages. It should be easy to adjust this script for other languages.

Also I created htm, rtf and txt versions of the signature files for each language to account for htm, rtf and plain text e-mail.

The network share mapping in the beginning of the script was to replace the previous logon script (a batch script) that just mapped a share. I left it in for reference.

The script was written for Outlook XP, 2007, 2010 and 2013, Windows XP, Vista, and 7. It should be somewhat future-proof. Outlook XP sometimes had trouble loading the logo picture and once in a while a user would call in to complain that their signature was gone. I then had to remove two very large (>1GB) files called ‘signatures’ and ‘handtekeningen’ from where there should be two directories with thoses names. This happened sporadically and the solution was simple so I never tracked the origin of the problem.

Here is the script. Note that lines may wrap here where they shouldn’t.


On Error Resume Next

' Map network drive
Set objNetwork = CreateObject("WScript.Network")
' objNetwork.MapNetworkDrive "P:" , "\\Data\data"

' Retrieve desktop and signature paths
' Retrieve user info from AD
' If they exist, backup the current signature folders
' Delete local signature folders
' Copy network signature folder to local system
' Edit user info into local signature file
' Duplicate local folder for Dutch language systems
' Set default signature in Outlook

' This is the name of the default signature, excluding any file extensions.
' For example: "strDefaultSignature = "Rotterdam-NL"
' Make sure this signature exists.

Dim strDefaultSignature
strDefaultSignature = "Rotterdam-NL"

Dim StrDefaultPhoneNr
StrDefaultPhoneNr = "010 - 123 45 67"

Dim StrFaxNL, StrFaxEN
StrFaxNL = "010 - 987 65 43"
StrFaxEN = "+31 10 987 65 43"

' Dim general variables
Dim van, naar, FldToMove

' Set some variables and some constants
Const ForReading = 1
Const ForAppending = 8

' Initiate filesystem and objects
Dim FSO, wshShell
set FSO=CreateObject("Scripting.FileSystemObject")
Set wshShell = CreateObject( "WScript.Shell" )

' Retrieve desktop and signature paths
dim StrSigPath, StrLogonServer
StrSigPath=wshShell.ExpandEnvironmentStrings("%appdata%") & "\Microsoft"
StrLogonServer=wshShell.ExpandEnvironmentStrings("%logonserver%")

strSigPathNL = StrSigPath & "\Handtekeningen\"
strSigPathEN = StrSigPath & "\Signatures\"

' Retrieve user info from AD
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
strName = objUser.FullName
strPhone = objUser.TelephoneNumber
strMobile = objUser.Mobile
strEmail = objUser.emailaddress
strInfo = objUser.info 'Field containing extra text the user wants before signature
arrInfo=split(strInfo, vbcrlf)

' Format office phone number
if StrPhone"" then
if len(StrPhone)>9 then
if IsNumeric(StrPhone) then
StrPhone=left(StrPhone, 3) & Chr(32) & "-" & Chr(32) & mid(StrPhone,4,3) & Chr(32) & mid(StrPhone, 7, 2) & Chr(32) & mid(StrPhone, 9, 2)
else
StrPhone=StrDefaultPhoneNr
end if
else
StrPhone=StrDefaultPhoneNr
end if
else
StrPhone=StrDefaultPhoneNr
end if
StrPhoneNL = StrPhone
StrPhoneEN = "+31" & Chr(32) & right(StrPhone, len(StrPhone)-1)
StrPhoneEN = replace(StrPhoneEN, "-", "")

' Format mobile phone number
if StrMobile"" then
if len(StrMobile)>9 then
if IsNumeric(StrMobile) then
StrMobile=left(StrMobile, 2) & Chr(32) & "-" & Chr(32) & mid(StrMobile, 3, 3) & Chr(32) & mid(StrMobile, 6, 3) & Chr(32) & mid(StrMobile, 9, 2)
end if
end if
end if
StrMobileNL = StrMobile
StrMobileEN = "+31" & Chr(32) & right(StrMobile, len(StrMobile)-1)
StrMobileEN = replace(StrMobileEN, "-", "")

' Delete the signature folders if they exist
Dim DelFld, backupfld, backupmaker

if FSO.FolderExists(strSigPathNL) then
van=left(strSigPathNL, len(strSigPathNL)-1)
naar=van & "-backup"

' If no backupfolder already exists, make a backup. This will backup the user's original
' signature files and not overwrite them.

if not FSO.FolderExists(naar) then
set FldToMove=FSO.GetFolder(van)
FldToMove.Move(naar)
else
' If a signature backup folder already exists, do not overwrite it.
set DelFld=FSO.GetFolder(strSigPathNL)
DelFld.Delete true
end if
end if

if FSO.FolderExists(strSigPathEN) then
van=left(strSigPathEN, len(strSigPathEN)-1)
naar=van & "-backup"

if not FSO.FolderExists(naar) then
set FldToMove=FSO.GetFolder(van)
FldToMove.Move(naar)
else
set DelFld=FSO.GetFolder(strSigPathEN)
DelFld.Delete true
end if
end if

' Create a new signature folder
Dim MkFld
Set MkFld=FSO.CreateFolder(strSigPathEN)

' Copy contents of network signature folder
Dim NetworkSigFld, flds, subfld, files
Set NetworkSigFld=FSO.GetFolder(StrLogonServer & "\NETLOGON\Signatures")

' Copy folders
Set flds=NetworkSigFld.SubFolders
For Each subfld in flds
FSO.CopyFolder subfld, strSigPathEN
next
set flds=nothing

' Copy files
Set files=NetworkSigFld.files
For Each sigfile in files
sigfile.Copy strSigPathEN
next
set files=nothing
Set NetworkSigFld=nothing

' Edit signtature htm files
Dim LocalSigFld, SigFile, TemplateFile, StrLine, HtmFile, DelFile, ext, BaseSigFile
Set LocalSigFld=FSO.GetFolder(strSigPathEN)
set files=LocalSigFld.files
for each SigFile in files
van=strSigPathEN & SigFile.Name
if Instr(SigFile.Name, "-EN")>0 then
StrPhone = StrPhoneEN
StrFax = StrFaxEN
StrMobile = StrMobileEN
else
StrPhone = StrPhoneNL
StrFax = StrFaxNL
StrMobile = StrMobileNL
end if
ext=lcase(right(van, 4))
baseSigFile=replace(van, ext, "")
naar=baseSigFile & ".tmp"
If FSO.FileExists(strSigPath & naar) then
FSO.FileDelete strSigPath & naar
end if
FSO.MoveFile van, naar

' Replace placeholders with values
Set TemplateFile=FSO.OpenTextFile(BaseSigFile & ".tmp")
Set HtmFile=FSO.OpenTextFile(BaseSigFile & ext, ForAppending, True)

' Set logo path
Dim strLogoPath
strLogoPath=BaseSigFile & "_files\becologo.jpg"

' Add custom signature text
'#1F497D = Outlook 2010 default response color
if strInfo"" and ext=".htm" then
if inStr(strInfo, vbcrlf)>0 then
HtmFile.WriteLine("")
for linenr=1 to uBound(arrInfo)
HtmFile.WriteLine(arrInfo(linenr) & "
")
next
HtmFile.WriteLine("
")
HtmFile.WriteLine("
")
end if
end if

' Scan template file for placeholders and replace them
Do until TemplateFile.AtEndOfStream
StrLine=TemplateFile.ReadLine
strLine=replace(StrLine, "[LOGOPATH]", strLogoPath)
StrLine=replace(StrLine, "[PHONE]", strPhone)
StrLine=replace(StrLine, "[MOBILEPHONE]", strMobile)
StrLine=replace(StrLine, "[EMAIL]", strEmail)
StrLine=replace(StrLine, "[FAX]", StrFax)
StrLine=replace(StrLine, "[FULLNAME]", strName)
' Write to htm file
HtmFile.WriteLine(StrLine & VBCrLf)
Loop

set HtmFile=nothing
set TemplateFile=nothing

FSO.DeleteFile BaseSigFile & ".tmp"
next

' Copy _files directory to _bestanden directory for Dutch language systems
dim EN_name, NL_name
Set ENfolders=FSO.GetFolder(strSigPathEN)
set flds=ENfolders.SubFolders
for each subfld in flds
EN_name=subfld.name
NL_name=left(EN_name, len(EN_name)-5) & "bestanden"
FSO.CopyFolder subfld, strSigPathEN & NL_name
next
set flds=nothing
set ENfolders=nothing

' Copy Signature directory to bestanden directory for Dutch language systems
van=left(strSigPathEN, len(strSigPathEN)-1)
naar=left(strSigPathNL, len(strSigPathNL)-1)
FSO.CopyFolder van, naar

' Set signature as default in Outlook.
Set objWord = CreateObject("Word.Application")
objWord.Visible = false
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
objSignatureObject.NewMessageSignature = strDefaultSignature

' Stop Outlook Process or Outlook won't update
Dim StrComputer, objWMIService, colProcessList
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery _
("SELECT * FROM Win32_Process WHERE Name = 'outlook.exe'")
For Each objProcess in colProcessList
objProcess.Terminate()
Next

' Close filesystem and Windows scripting host objects
set FSO=nothing
set wshShell=nothing

Here are the original signature files. I removed the folder containing the logo and changed the addresses. The [KEYWORDS] in the files are the literal placeholders the original files used.