OutlookSignatureDeploy.vbs

On Error Resume Next

'References
'All objuser.XXXX and there counterparts in AD
'https://ss64.com/vb/syntax-userinfo.html

Set objSysInfo = CreateObject("ADSystemInfo")
Set WshShell = CreateObject("WScript.Shell")

strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)

strName = objUser.FullName
strTitle = objUser.Title
strCred = objUser.info
strStreet = objUser.StreetAddress
strState = objUser.st
strLocation = objUser.l
strPostCode = objUser.PostalCode
strPhone = objUser.TelephoneNumber
strDirect = objUser.ipPhone
strMobile = objUser.Mobile
strEmail = objUser.mail
strWebsite = objUser.wWWHomePage
strOffice = objUser.physicalDeliveryOfficeName

'Creates word application with formatting - .htm
Set objWord = CreateObject("Word.Application")

Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection

Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature

Set objSignatureEntries = objSignatureObject.EmailSignatureEntries

'Signature Font
objSelection.Font.Name = "Verdana"
objSelection.Font.Size = 11 'Carries over unless specified again elsewhere

'Regards
objSelection.font.color = rgb(0,0,0)
objSelection.TypeText "Regards,"
objSelection.TypeText Chr(11)

'Line break - Don't know a better way
objSelection.TypeText space(1)
objSelection.TypeText Chr(11)

'Username line
objSelection.Font.Size = 13
objSelection.Font.Bold = true
if (strCred) Then objSelection.TypeText strName & ", " & strCred Else objSelection.TypeText strName
objSelection.Font.Bold = false

'Job title line
objSelection.Font.Size = 11
objSelection.TypeParagraph()
objSelection.ParagraphFormat.LineSpacing = 16
objSelection.TypeText strTitle
objSelection.TypeText Chr(11)

'Location line
objSelection.Font.Bold = true
objSelection.font.color = rgb(210,73,42)
objSelection.TypeText strOffice & " Office " & "| FLOTH Sustainable Building Consultants"
objSelection.Font.Bold = False
objSelection.TypeText Chr(11)

'Address line
objSelection.font.color = rgb(0,0,0)
objSelection.TypeText strStreet & ", " & strLocation & ", " & strState & ", " & strPostCode
objSelection.TypeText Chr(11)

'Contact line
objSelection.font.color = rgb(0,0,0)
objSelection.TypeText "P: " & strPhone & " | D: " & strDirect & " | M: " & strMobile & " | E: " & strEmail & " | W: " & strWebsite
objSelection.TypeText Chr(11)

'Image description or disclaimer
objSelection.Font.Bold = true
objSelection.font.color = rgb(0,187,0)
objSelection.TypeText "Winner of the 2017 Brisbane Lord Mayors Business Awards for Sustainability in Business, awarded to Floth for 69 Robertson Street, Fortitude Valley."
objSelection.Font.Bold = false
objSelection.TypeText Chr(11)

'New signature image adding - Point towards image file NETLOGON so everyone has access
Set shp = objSelection.InlineShapes.AddPicture("S:\_New Machine Install\SIGTEST\LMBA_Landscape_DarkGreen_668x126.jpg")
shp.LockAspectRatio = msoFalse
shp.Width = 668
shp.Height = 126

'Experimental code for multuple departments with different signature images
' If (objUser.Department = "COMPANY NAME.") Then
             ' objSelection.InlineShapes.AddPicture("\LMBA_Landscape_DarkGreen_668x126.jpg")


' ElseIf (objUser.Department = "COMPANY NAME") Then
        ' objSelection.InlineShapes.AddPicture("\LMBA_Landscape_DarkGreen_668x126.jpg")

' Else
        ' objSelection.InlineShapes.AddPicture("\LMBA_Landscape_DarkGreen_668x126.jpg")

' End If


Set objSelection = objDoc.Range()

objSignatureEntries.Add "Email Signature", objSelection
objSignatureObject.NewMessageSignature = "Email Signature"
objSignatureObject.ReplyMessageSignature = "Email Signature"

objDoc.Saved = True
objWord.Quit