Outlook Email Signature Script, VBS |
Outlook Email Signature Script, VBS |
Aug 4 2010, 02:16 PM
Post
#1
|
|
Senior Member Group: Official Member Posts: 1,574 Joined: Aug 2007 Member No: 555,438 |
The following script creates an email signature for Outlook 2003/2007. Works flawlessly. I pushed it out to my users via group policy. It runs on user login if the user belongs to the right group.
CODE '==========================
' ' ############### Script that creates a standard company signature for all users (in a corporate environment); pulling data from Active Directory - dynamic logo insertion depending on department field if needed. ' ' Joshua Keal ' ' Kudos to Severn Dickinson, ScriptCentre, and Tristan Miller ' ' 08-04-2010. ' '=========================== On Error Resume Next Set objSysInfo = CreateObject("ADSystemInfo") ' ########### This section connects to Active Directory as the currently logged on user strUser = objSysInfo.UserName Set objUser = GetObject("LDAP://" & strUser) ' ########### This section sets up the variables we want to call in the script (items on the left; whereas the items on the right are the active directory database field names) - ie strVariablename = objuser.ad.databasename strSignatureName = "Signature Name" strLogoPath = "c:\folder\subfolder\picture.gif" strGiven = objuser.givenName strSurname = objuser.sn strAddress1 = objUser.streetAddress strAddress1EXT = objUser.postofficebox strAddress2 = objuser.l strAddress3 = objuser.st strPostcode = objuser.postalcode strExt = objuser.homephone strTitle = objUser.Title strEmail =objuser.mail strCompany = objUser.Company strPhone = objUser.telephoneNumber strFax = objUser.facsimileTelephoneNumber strMobile = objuser.mobile REM strWeb = objuser.wWWHomePage REM strNotes = objuser.info REM strDepartment = objUser.Department REM strIP = objuser.ipPhone REM strEmailTEXT = "Email: " REM strCountry = objuser.c ' ### Sets up word template Set objWord = CreateObject("Word.Application") Set objDoc = objWord.Documents.Add() Set objSelection = objWord.Selection objSelection.Style = "No Spacing" Set objEmailOptions = objWord.EmailOptions Set objSignatureObject = objEmailOptions.EmailSignature Set objSignatureEntries = objSignatureObject.EmailSignatureEntries '### creates a table in the word document with one row and two cells objselection.TypeText Chr(11) Const Number_of_rows = 1 Const Number_of_columns = 2 Const END_OF_STORY = 1 objSelection.TypeParagraph() Set objRange = objSelection.Range objDoc.Tables.Add objRange, number_of_rows, number_of_columns Set objTable = objDoc.Tables(1) objTable.AutoFitBehavior(1) '### Sets up the first cell with the logo inside Set objCell = objTable.Cell(1, 1) Set objCellRange = objCell.Range objSelection.Range = objCell.Range objSelection.InlineShapes.AddPicture(strLogoPath) '### Sets up the second cell as follows '### <name> '### <title> '### <email> '### <company> '### <address>, <city>, <state> <zip> '### Tele: <office number>, Extension:<extention> '### Mobile: <mobile number>, Fax: <fax number> Set objCell = objTable.Cell(1, 2) Set objCellRange = objCell.Range objCell.Select '### Set up the formatting for the name and title objSelection.Font.Name = "Verdana" objSelection.Font.Size = 10 objSelection.Font.Bold = True objSelection.Font.Color = RGB (032,178,089) '### Type the name and title objSelection.TypeText strGiven & " " & strSurname & Chr(11) &_ strTitle & Chr(11) '### Set up the formatting for the name and title objSelection.Font.Size = 8 objSelection.Font.Bold = False objSelection.Font.Color = RGB (018,123,190) '### check to see if the mobile number is listed and add it to the signature if it exists IF Len(strMobile) = 12 Then objSelection.TypeText strEmail & Chr(11) &_ strCompany & Chr(11) &_ strAddress1 & ", " & strAddress2 & ", " & strAddress3 & " " & strPostcode & Chr(11) &_ "Tele:" & strPhone & ", Extension:" & strExt & Chr(11) &_ "Mobile:" & strMobile & ", " & "Fax:" & strFax Else objSelection.TypeText strEmail & Chr(11) &_ strCompany & Chr(11) &_ strAddress1 & ", " & strAddress2 & ", " & strAddress3 & " " & strPostcode & Chr(11) &_ "Tele:" & strPhone & ", Extension:" & strExt & Chr(11) &_ "Fax:" & strFax End If '### set the signature up as strSignatureName and tell outlook to use it as default Set objSelection = objDoc.Range() objSignatureEntries.Add strSignatureName, objSelection objSignatureObject.NewMessageSignature = strSignatureName objSignatureObject.ReplyMessageSignature = strSignatureName '### save the signature objDoc.Saved = True objWord.Quit |
|
|
Aug 4 2010, 04:05 PM
Post
#2
|
|
/人◕‿‿◕人\ Group: Official Member Posts: 8,283 Joined: Dec 2007 Member No: 602,927 |
|
|
|
Aug 4 2010, 05:17 PM
Post
#3
|
|
Live long and prosper. Group: Staff Alumni Posts: 10,142 Joined: Apr 2007 Member No: 514,926 |
|
|
|
Aug 4 2010, 06:24 PM
Post
#4
|
|
/人◕‿‿◕人\ Group: Official Member Posts: 8,283 Joined: Dec 2007 Member No: 602,927 |
that isn't a very good answer
|
|
|
Aug 6 2010, 07:35 AM
Post
#5
|
|
Senior Member Group: Official Member Posts: 1,574 Joined: Aug 2007 Member No: 555,438 |
|
|
|
Aug 6 2010, 08:24 AM
Post
#6
|
|
Tick tock, Bill Group: Administrator Posts: 8,764 Joined: Dec 2005 Member No: 333,948 |
That's pretty cool, Josh. I'll definitely pass it on (if the IT folks didn't know this already).
|
|
|