------------------------------------------------------------------------------------------------------------------
'Option Explicit
On Error Resume Next
'==================================================
'Create Outlook signature from Word template
'==================================================
'----- Declarations -----
Const wdWord = 2
Const wdParagraph = 4
Const wdExtend = 1
Const wdCollapseEnd = 0
'--------------------------------------------------------------
'----- Modify these variables appropriately ----
'--------------------------------------------------------------
strTemplatePath = "\\server\Signatures\"
strTemplateName = "ACME_Signature_Template.docx"
strReplyTemplateName = "ACME_Reply_Signature_Template.docx"
'----- Connect to AD and get user info -----'
Set objSysInfo = CreateObject("ADSystemInfo")
Set WshShell = CreateObject("WScript.Shell")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
strFirstname = objUser.FirstName
strLastName = objUser.givenName
strInitials = objUser.initials
strName = objUser.FullName
strTitle = objUser.Title
strDescription = objUser.Description
strOffice = objUser.physicalDeliveryOfficeName
strCred = objUser.info
strStreet = objUser.StreetAddress
strLocation = objUser.l
strPostCode = objUser.PostalCode
strPhone = objUser.TelephoneNumber
strMobile = objUser.Mobile
strFax = objUser.FacsimileTelephoneNumber
strEmail = objUser.mail
strWeb = objuser.wWWHomePage
'----- Apply any modifications to Active Directory fields -----
'Use company info page if user does not have a Linked-In account specified
if strweb = "" Then strweb = "http://www.linkedin.com/company/58654"
'----- Open Word template in read-only mode {..Open(filename,conversion,readonly)} -----
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Open(strTemplatePath & strTemplateName,,True)
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
'----- Replace template text placeholders with user specific info -----
SearchAndRep "[Name]", strName, objWord
SearchAndRep "[Title]", strTitle, objWord
SearchAndRep "[Phone]", strPhone, objWord
SearchAndRep "[Mobile]", strMobile, objWord
SearchAndRep "[Fax]", strFax, objWord
SearchAndRep "[OfficePhone]", strOfficePhone, objWord
SearchAndRep "[email]", strEmail, objWord
SearchAndRep "[web]", strWeb, objWord
'----- Replace template hyperlink placeholders with user specific info -----
SearchAndRepHyperlink "[email]", strWeb, objDoc
SearchAndRepHyperlink "[web]", strWeb, objDoc
'----- Set signature in Outlook -----
Set objSelection = objDoc.Range()
objSignatureEntries.Add "Full Signature", objSelection
objSignatureObject.NewMessageSignature = "Full Signature"
'see note below if a different reply signature is desired
objSignatureObject.ReplyMessageSignature = "Full Signature"
'----- Close signature template document -----
objDoc.Saved = TRUE
objDoc.Close
objWord.Quit
'----------------------------------------------------------------------------------------------------
'note...if a different reply signature is desired, copy above code from the
'open template section. This time through open
'the reply template instead.
'-----------------------------------------------------------------------------------------------------
'----- Subrouting to search and replace template text placeholders -----
Sub SearchAndRep(searchTerm, replaceTerm, WordApp)
WordApp.Selection.GoTo 1
With WordApp.Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWholeWord = True
.Text = searchTerm
.Execute ,,,,,,,,,replaceTerm
End With
End Sub
'----- Subrouting to search and replace template hyperlink placeholders -----
' Note this can be picky...if it does not work re-create hyperlink in the template
Sub SearchAndRepHyperlink(searchLink, replaceLink, WordDoc)
Set colHyperlinks = WordDoc.Hyperlinks
For Each objHyperlink in colHyperlinks
If objHyperlink.Address = searchLink Then
objHyperlink.Address = replaceLink
End If
Next
End Sub
---------------------------------------------------------------------------------------------------------------
Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.
Comments (2)
Commented:
Commented:
i want to pull the Photo form the users AD profile and add it to the signature is this possible ? any help appreciated