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:
- The default signature file is copied to the user’s computer.
- The user’s information is pulled from AD.
- The placeholders in the html signature file replaced by the info from the user account.
- 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.
Kapitein… can you share the HTML code you mention above? I’d like to see how you use the placeholders as an example. Thanks for any help!
Ken, I added the files to the bottom of the article. Clicking the link will take you to the attachment page where you need to click another link which will give you a zip file containing the files.
I need to read a WordPress book someday…
Public folders, archived mailboxes that are online, or common mail
boxes may disappear from the folder list in Outlook 2010.
Kapitein, thanks for sharing your knowledge… I have tried for Outlook 2013, configurating a GPO from Windows server 2012, but it didn´t work… in this explanation do you use GPO to run the script in the side of the server?
I wasn’t using GPOs. The scripts were run client-side but loaded from the DC (the netlogon share).
Please note that newer versions of Exchange facilitate central signature management a lot better.
Very nice blog! in case, if some one needs help for router. they can simply visit our website and find the help.
fixotip troubleshooting blog
Yes, that would be much simpler. Thank you for pointing it out.
On Error Resume Next
Dim objUser,userName,domainName
Set objUser = CreateObject(“WScript.Network”)
userName = objUser.UserName
domainName = objUser.UserDomain
FUNCTION GetUserDN(BYVAL UN, BYVAL DN)
Dim ObjTrans,strUserDN
Set ObjTrans = CreateObject(“NameTranslate”)
objTrans.init 1, DN
objTrans.set 3, DN & “\” & UN
strUserDN = objTrans.Get(1)
GetUserDN = strUserDN
END FUNCTION
‘msgbox userName
‘if userName=”nofarm” then
‘msgbox userName & “1”
Set objLDAPUser = GetObject(“LDAP://” & GetUserDN(userName,domainName))
‘Getting prepared to write the files
Dim objFSO, objWsh, appDataPath, pathToCopyTo, plainTextFile, plainTextFilePath, htmlFile, htmlFilePath
Set objFSO = CreateObject(“Scripting.FileSystemObject”)
Set objWsh = CreateObject(“WScript.Shell”)
appDataPath = objWsh.ExpandEnvironmentStrings(“%APPDATA%”)
pathToCopyTo = appDataPath & “\Microsoft\Signatures\”
If Not objFSO.FolderExists(pathToCopyTo) Then
objFSO.CreateFolder(pathToCopyTo)
End If
Dim iCell,iPhone,iFax,telephoneNumber,physicalDeliveryOfficeName,FacsimileTelephoneNumber,sStreetAddress,sTitle,sDescription
Dim sCell,sPhone,sFax
telephoneNumber = Cstr(objLDAPUser.telephoneNumber)
physicalDeliveryOfficeName = objLDAPUser.physicalDeliveryOfficeName
FacsimileTelephoneNumber = objLDAPUser.FacsimileTelephoneNumber
sStreetAddress = objLDAPUser.StreetAddress
sTitle =objLDAPUser.Title
sDescription = objLDAPUser.Description
If telephoneNumber “” then
iCell = telephoneNumber
sCell=””
If physicalDeliveryOfficeName “” then
iPhone=physicalDeliveryOfficeName
sPhone=””
If FacsimileTelephoneNumber “” then
iFax=FacsimileTelephoneNumber
sFax=””
else
iFax=” ”
sFax=” ”
end if
else
If FacsimileTelephoneNumber “” then
iPhone=FacsimileTelephoneNumber
sPhone=””
iFax=” ”
sFax=” ”
else
iPhone=” ”
sPhone=” ”
iFax=” ”
sFax=” ”
end if
end if
else
If physicalDeliveryOfficeName “” then
iCell=physicalDeliveryOfficeName
sCell=””
If FacsimileTelephoneNumber “” then
iPhone=FacsimileTelephoneNumber
sPhone=””
iFax=” ”
sFax=” ”
else
iPhone=” ”
sPhone=” ”
iFax=” ”
sFax=” ”
end if
else
If FacsimileTelephoneNumber “” then
iCell=FacsimileTelephoneNumber
sCell=””
iPhone=” ”
sPhone=” ”
iFax=” ”
sFax=” ”
else
iCell=” ”
sCell=” ”
iPhone=” ”
sPhone=” ”
iFax=” ”
sFax=” ”
end if
end if
end if
‘if userName=”nofarm” then
‘msgbox userName & “2” & ” ” & objLDAPUser.StreetAddress
‘end if
‘HTML signature – signatureENG.htm
if objLDAPUser.l “” then
htmlFilePath = pathToCopyTo & “English.htm”
Set htmlFile = objFSO.CreateTextFile(htmlFilePath, TRUE)
htmlfile.WriteLine(GetHTMLEng(objLDAPUser.DisplayName,objLDAPUser.l,iCell,iPhone,iFax,objLDAPUser.ST,objLDAPUser.postOfficeBox,sCell,sPhone,sFax))
end if
‘HTML signature – signatureHEB.htm
htmlFilePath = pathToCopyTo & “HEBREW.htm”
Set htmlFile = objFSO.CreateTextFile(htmlFilePath, TRUE)
htmlfile.WriteLine(GetHTML(sDescription,sTitle,iCell,iPhone,iFax,sStreetAddress,objLDAPUser.postOfficeBox,sCell,sPhone,sFax))
Set fso = CreateObject(“Scripting.FileSystemObject”)
If Not objFSO.FileExists(appDataPath & “\Microsoft\Signatures\cell.png”) Then fso.CopyFile “\\alonidc1\netlogon\Signature\cell.png”, appDataPath & “\Microsoft\Signatures\”,TRUE
If Not objFSO.FileExists(appDataPath & “\Microsoft\Signatures\fbl.jpg”) Then fso.CopyFile “\\alonidc1\netlogon\Signature\fbl.jpg”, appDataPath & “\Microsoft\Signatures\”,TRUE
If Not objFSO.FileExists(appDataPath & “\Microsoft\Signatures\FAX.png”) Then fso.CopyFile “\\alonidc1\netlogon\Signature\FAX.png”, appDataPath & “\Microsoft\Signatures\”,TRUE
If Not objFSO.FileExists(appDataPath & “\Microsoft\Signatures\LOGO.jpg”) Then fso.CopyFile “\\alonidc1\netlogon\Signature\LOGO.jpg”, appDataPath & “\Microsoft\Signatures\”,TRUE
If Not objFSO.FileExists(appDataPath & “\Microsoft\Signatures\Phone.png”) Then fso.CopyFile “\\alonidc1\netlogon\Signature\Phone.png”, appDataPath & “\Microsoft\Signatures\”,TRUE
If Not objFSO.FileExists(appDataPath & “\Microsoft\Signatures\LOGOEng.jpg”) Then fso.CopyFile “\\alonidc1\netlogon\Signature\LOGOEng.jpg”, appDataPath & “\Microsoft\Signatures\”,TRUE
If Not objFSO.FileExists(appDataPath & “\Microsoft\Signatures\Location.png”) Then fso.CopyFile “\\alonidc1\netlogon\Signature\Location.png”, appDataPath & “\Microsoft\Signatures\”,TRUE
Dim objSignatureObject ,objEmailOptions ,objWord
Set objWord = CreateObject(“Word.Application”)
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
If objLDAPUser.PostalCode = 1 then
objSignatureObject.NewMessageSignature = “English”
objSignatureObject.ReplyMessageSignature = “English”
Else
objSignatureObject.NewMessageSignature = “HEBREW”
objSignatureObject.ReplyMessageSignature = “HEBREW”
End If
‘objDoc.Saved = True
If blnWeOpenedWord Then objWord.Quit
‘end if
Set objUser = Nothing
Set ObjTrans = Nothing
Set objLDAPUser = Nothing
Set objFSO = Nothing
Set objWsh = Nothing
Set objWord = Nothing
If OutlookIsRunning Then oWshShell.Run “taskkill.exe /f /im Outlook.exe”, 0, False
Function OutlookIsRunning
On Error Resume Next
Set oAux = oOutlook.Session
OutlookIsRunning = (Err.number = 0)
On Error Goto 0
End Function
Set oApp = GetObject(, “Outlook.Application”)
If oApp Is Nothing Then
‘no need to do anything, Application is not running
Else
‘Application running
oApp.Session.Logoff
oApp.Quit
End If
Set oApp = Nothing
WScript.Sleep 5000
Err.Clear
‘ HTML HEB
FUNCTION GetHTML(BYVAL Description,BYVAL Title,BYVAL telephoneNumber,BYVAL physicalDeliveryOfficeName,BYVAL FacsimileTelephoneNumber,BYVAL StreetAddress,BYVAL postOfficeBox,BYVAL sCell,BYVAL sPhone,BYVAL sFax)
Dim Str
Str=”” & _
“” & _
“” & _
“” & _
“” & _
“” & _
“” & _
“” & _
“” & _
“” & Description & “” & _
“”& Title & “” & _
” ” & _
“” & sCell & ” ” & _
“” & telephoneNumber & ” ” & _
“” & sPhone & ” ” & _
“” & physicalDeliveryOfficeName & ” ” & _
“” & sFax & ” ” & _
“” & FacsimileTelephoneNumber & “” & _
“” & _
“” & _
” ” & _
” ” & StreetAddress & “” & _
“” & _
“” & _
” ” & _
” ” & _
” ” & _
” http://www.alony.co.il” & _
” ” & _
” ” & _
“” & _
“”
GetHTML = Str
END FUNCTION
‘ HTML Eng
FUNCTION GetHTMLEng(BYVAL Description,BYVAL Title,BYVAL telephoneNumber,BYVAL physicalDeliveryOfficeName,BYVAL FacsimileTelephoneNumber,BYVAL StreetAddress,BYVAL postOfficeBox,BYVAL sCell,BYVAL sPhone,BYVAL sFax)
Dim Str,kCell,kPhone,kFax
If sCell = ” ” then
kCell = ” ”
else
kCell = “+972-” & Mid(telephoneNumber,2,10)
end if
If sPhone = ” ” then
kPhone = ” ”
else
kPhone = “+972-” & Mid(physicalDeliveryOfficeName,2,10)
end if
If sFax = ” ” then
kFax = ” ”
else
kFax = “+972-” & Mid(FacsimileTelephoneNumber,2,10)
end if
Str=”” & _
“” & _
“” & _
“” & _
“” & _
“” & _
“” & _
“” & _
“” & _
“” & Description & “” & _
“”& Title & “” & _
” ” & _
“” & sCell & ” ” & _
“” & kCell & ” ” & _
“” & sPhone & ” ” & _
“” & kPhone & ” ” & _
“” & sFax & ” ” & _
“” & kFax & “” & _
“” & _
“” & _
” ” & _
” ” & StreetAddress & “” & _
“” & _
“” & _
” ” & _
” ” & _
” ” & _
” http://www.alony.co.il” & _
” ” & _
” ” & _
“” & _
“”
GetHTMLEng = Str
END FUNCTION