VBScript: Deploy Outlook Stationery and Signature

Today I was tasked with scripting a custom and uniform stationery and signature for each user in the domain.  After thinking about this for a little while, I decided the best way to tackle this was to leave the stationery and signature HTML files in tact with a few alterations…

For the HTML files, simply pop them open in an editor (notepad for example – certainly not word!)  and find the variables.  In my example, i used the Full Name, Email Address and Mobile Number as the variables in the stationery and replaced them with %FULLNAME%, %EMAIL% and %MOBILE%.

To distribute the file, choose your preferred method mine is a simple Group Policy with a logon script that copies these files, then calls the VBScript.

The Script

Below is the script, it is fairly easy to understand, shoot me a message if not and I’ll go into more detail afterwards.

'Set Variables (LOOOOOOOTS of Variables)
dim objShell, objSysInfo, strUser, objUser, strName, strMobile, _
    strEmail, appdata, strStationery, strSignature, objWord, _
    strComputer, strKeyPath, strRegValueName, strRegValue, _
    strValue, signature, stationery
    
set objShell = CreateObject("WScript.Shell")
set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
set objUser = GetObject("LDAP://" & strUser)
strName = objUser.FullName
strMobile = objUser.Mobile
strEmail = objUser.emailAddress
appdata = objShell.ExpandEnvironmentStrings("%appdata%")
strStationery = appdata & "\Microsoft\Stationery\Stationery.html"
strSignature = appdata & "\Microsoft\Signatures\Signature-Reply.htm"
set objWord = CreateObject("Word.Application")
strKeyPath = "SOFTWARE\Microsoft\Office\" & objWord.Version _
    & "\Common\MailSettings"
strRegValueName = "NewStationery"
strValue = "Stationery"
objWord.EmailOptions.EmailSignature.NewMessageSignature = ""
objWord.EmailOptions.EmailSignature.ReplyMessageSignature = "Signature-Reply"
'Set Registry to selected stationery
objShell.RegWrite strKeyPath & strRegValueName, strRegValue, "REG_SZ"

'Read source stationery and signature
stationery = GetFile(strStationery)
signature = GetFile(strSignature)

'Write the modified files
WriteFile strStationery, ReplaceTemplate(stationery)
WriteFile strSignature, ReplaceTemplate(signature)

'Read file function
function GetFile(FileName)
  If FileName<>"" Then
    Dim FS, FileStream
    Set FS = CreateObject("Scripting.FileSystemObject")
      on error resume Next
      Set FileStream = FS.OpenTextFile(FileName)
      GetFile = FileStream.ReadAll
  End If
End Function

'Write modified files
function WriteFile(FileName, Contents)
  Dim OutStream, FS

  on error resume Next
  Set FS = CreateObject("Scripting.FileSystemObject")
    Set OutStream = FS.OpenTextFile(FileName, 2, True)
    OutStream.Write Contents
End Function

'Replace blocks in template with user data.
function ReplaceTemplate(TempFile)
    TempFile = replace(TempFile, "%FULLNAME%", strName)
    TempFile = replace(TempFile, "%EMAIL%", strEmail)
    
    If strMobile = "" Then    
        TempFile = replace(TempFile, "%MOBILE%", "")
    Else TempFile = replace(TempFile, "%MOBILE%", "Mob:" & strMobile)
    End If    
    
    ReplaceTemplate = TempFile
End Function