Posted by: Uronacid Aug 4 2010, 02:16 PM
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
Posted by: ButtsexV2 Aug 4 2010, 04:05 PM
QUOTE(Uronacid @ Aug 4 2010, 02:16 PM)
Works flawlessly.
so why is it in tech help?
Posted by: synapse Aug 4 2010, 05:17 PM
QUOTE(ButtsexV2 @ Aug 4 2010, 05:05 PM)
so why is it in tech help?
Tech Help. Ask questions about programs
and get solutions to tech problems.
Posted by: ButtsexV2 Aug 4 2010, 06:24 PM
that isn't a very good answer
Posted by: Uronacid Aug 6 2010, 07:35 AM
QUOTE(ButtsexV2 @ Aug 4 2010, 07:24 PM)
that isn't a very good answer
Don't be retarded.
Posted by: superstitious Aug 6 2010, 08:24 AM
That's pretty cool, Josh. I'll definitely pass it on (if the IT folks didn't know this already).