Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Outlook email signature

Status
Not open for further replies.

sparkbyte

Technical User
Sep 20, 2002
879
0
0
US
Has anyone seen a script or example for creating and inserting a corporate standard signature into Outlook or outlook Express that might be able to run from a logon script or similar??

Thanks
John Fuhrman
 
Your best bet is to get a copy of Exclaimer.

You can do it from your Exchange Server with an event sink. Take a look at this MS article on the subject.


I hope you find this post helpful.

Regards,

Mark

Check out my scripting solutions at
Work SMARTER not HARDER. The Spider's Parlor's Admin Script Pack is a collection of Administrative scripts designed to make IT Administration easier! Save time, get more work done, get the Admin Script Pack.
 
I managed to find large part so of this script (source unknown now) and added my own bits etc (i know the reg file parts can be done better)

we came across various versions of Word (2007 mainly) with double line spacing set for an html signature, so the Reg files set the signature to RTF to eliminate double line spacing

---------------------------------------
On Error Resume Next

Const RTF = 6
Const Text = 4
Const HTML = 8

'declare

Dim qQuery, objSysInfo, objuser
Dim FullName, EMail, Title, PhoneNumber, MobileNumber, FaxNumber, OfficeLocation, Department
Dim web_address, FolderLocation, HTMFileString, StreetAddress, Town, State, Company
Dim ZipCode, PostOfficeBox, UserDataPath

'check AD

Set objSysInfo = CreateObject("ADSystemInfo")
objSysInfo.RefreshSchemaCache
qQuery = "LDAP://" & objSysInfo.Username
Set objuser = GetObject(qQuery)

'Retrieve

SPACE = ""
FullName = objuser.displayname
LogonName = objuser.userPrincipalName
EMail = objuser.mail
Company = objuser.Company
Title = objuser.title
PhoneNumber = objuser.TelephoneNumber
FaxNumber = objuser.FaxNumber
OfficeLocation = objuser.physicalDeliveryOfficeName
StreetAddress = objuser.streetaddress
PostofficeBox = objuser.postofficebox
Department = objUser.Department
ZipCode = objuser.postalcode
Town = objuser.l
MobileNumber = objuser.TelephoneMobile
web_address = "Disclaimer = "Company Ltd, London Road"
Disclaimer2 = "West Berkshire RG28"
Disclaimer3 = "Registered Company Number xxxxxxxxx"
Logo = "\\exchange01\NETLOGON\signature.bmp"

'Check Outlook Version

set outlook = createobject("outlook.application")

If outlook.version = "9.0.0.2711" or outlook.version = "9.0.0.3011" or outlook.version = "9.0.0.3821" or outlook.version = "9.0.0.4105" or outlook.version = "9.0.0.4201" or outlook.version = "9.0.0.4527" or outlook.version = "9.0.0.5414" Then

'Wscript.Echo "Outlook 2000"
olk2000 = True

End If

'Create signature based on 2000

If olk2000 = True Then
Set wshShell = WScript.CreateObject("WScript.Shell" )
StrProfile = WshShell.ExpandEnvironmentStrings("%USERPROFILE%")+"\Application Data\Microsoft\Signatures\"


Set objWord = CreateObject("Word.Application")
objWord.Visible = False

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

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "10"
objSelection.Font.Bold = True
objSelection.TypeText FullName
objSelection.TypeParagraph()

objSelection.TypeText SPACE
objSelection.TypeParagraph()

objSelection.InlineShapes.AddPicture(Logo)
objSelection.TypeParagraph()

objSelection.TypeText SPACE
objSelection.TypeParagraph()

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "10"
objSelection.Font.Bold = True
objSelection.TypeText "T: "

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "10"
objSelection.Font.Bold = False
objSelection.TypeText PhoneNumber
objSelection.TypeParagraph()

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "10"
objSelection.Font.Bold = True
objSelection.TypeText "F: "

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "10"
objSelection.Font.Bold = False
objSelection.TypeText FaxNumber
objSelection.TypeParagraph()

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "10"
objSelection.Font.Bold = True
objSelection.TypeText "E: "

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "10"
objSelection.Font.Bold = False
objSelection.Hyperlinks.Add objSelection.Range, Email, "", "", Email
objSelection.TypeParagraph()

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "10"
objSelection.Font.Bold = True
objSelection.TypeText "W: "

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "10"
objSelection.Font.Bold = False
objSelection.Hyperlinks.Add objSelection.Range, web_address, "", "", web_address
objSelection.TypeParagraph()

objSelection.TypeText SPACE
objSelection.TypeParagraph()

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "8"
objSelection.Font.Bold = False
objSelection.TypeText Disclaimer
objSelection.TypeParagraph()

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "8"
objSelection.Font.Bold = False
objSelection.TypeText Disclaimer2
objSelection.TypeParagraph()

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "8"
objSelection.Font.Bold = False
objSelection.TypeText Disclaimer3
objSelection.TypeParagraph()

objDoc.SaveAs strProfile & "Default.rtf", RTF
objDoc.SaveAs strProfile & "Default.txt", Text
objDoc.SaveAs strProfile & "Default.htm", HTML

objWord.Quit

'Make signature an RTF by default

Wshshell.run "regedit.exe /s MailFormat2000.reg"

'Create based on XP or 2003

Else
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

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "10"
objSelection.Font.Bold = True
objSelection.TypeText FullName
objSelection.TypeParagraph()

objSelection.TypeText SPACE
objSelection.TypeParagraph()

objSelection.InlineShapes.AddPicture(Logo)
objSelection.TypeParagraph()

objSelection.TypeText SPACE
objSelection.TypeParagraph()

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "10"
objSelection.Font.Bold = True
objSelection.TypeText "T: "

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "10"
objSelection.Font.Bold = False
objSelection.TypeText PhoneNumber
objSelection.TypeParagraph()

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "10"
objSelection.Font.Bold = True
objSelection.TypeText "F: "

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "10"
objSelection.Font.Bold = False
objSelection.TypeText FaxNumber
objSelection.TypeParagraph()

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "10"
objSelection.Font.Bold = True
objSelection.TypeText "E: "

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "10"
objSelection.Font.Bold = False
objSelection.Hyperlinks.Add objSelection.Range, Email, "", "", Email
objSelection.TypeParagraph()

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "10"
objSelection.Font.Bold = True
objSelection.TypeText "W: "

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "10"
objSelection.Font.Bold = False
objSelection.Hyperlinks.Add objSelection.Range, web_address, "", "", web_address
objSelection.TypeParagraph()

objSelection.TypeText SPACE
objSelection.TypeParagraph()

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "8"
objSelection.Font.Bold = False
objSelection.TypeText Disclaimer
objSelection.TypeParagraph()

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "8"
objSelection.Font.Bold = False
objSelection.TypeText Disclaimer2
objSelection.TypeParagraph()

objSelection.Font.Name = "Tahoma"
objSelection.Font.Size = "8"
objSelection.Font.Bold = False
objSelection.TypeText Disclaimer3
objSelection.TypeParagraph()

Set objSelection = objDoc.Range()
objSignatureEntries.Add "Feltham", objSelection

objSignatureObject.NewMessageSignature = "Feltham"
objSignatureObject.ReplyMessageSignature = "Feltham"
objDoc.Saved = True

objWord.Quit

Wshshell.run "regedit.exe /s MailFormat2000+.reg"

End if
Wscript.Echo "Script Completed"

------------------------

the Reg files had in 'MailFormat2000+.reg
-----------------------------------------------
Windows Registry Editor Version 5.00

[HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Outlook\Options\Mail]
"EditorPreference"=dword:00030001

[HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Options\Mail]
"EditorPreference"=dword:00030001
-------------------------------------
and in MailFormat.reg
-------------------------------------
Windows Registry Editor Version 5.00

[HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Outlook\Options\Mail]
"EditorPreference"=dword:00030001
-------------------------------------

Gurner
 
to stop it re-running everytime they logon, i added this to the logon script pointing to the above vbs script, and placed a blank file called prof.dat in the netlogon share too

-----------------------------------
if EXIST "C:\prof.dat" ( quit ) ELSE (start \\exchange01\NETLOGON\OutlookSignature.vbs)
copy %0\..\prof.dat C:\prof.dat
-----------------------------------

Gurner
 
Thanks, that should give me a good starting place to be able to get signatures working for Outlook.

I also found and article on How to add a disclaimer to outgoing SMTP messages in Visual Basic script on the MS support site that makes me think I may be able to use this to be able to apply signatures at the exchange server. Hopefully using the script registrations on the exchange server it will also apply to the exchange OWA (Webmail) also. I know this is intended for a domain wide legal disclaimer, but maybe with a bit of trial and error I can get it working.

Thanks for the great script.

 
I am guessing you didn't bother to read my post sparkbyte, you are referencing the very same KB article I provided to you in the first reply to this thread.
 
I had looked at it, but at the time I wasn't sure how I could use the information. I had also found another VBscript that creates an HTML signature for outlook clients and with the additional research I had began on Exchange server I had ran into the article that you had pointed out again but hadn't realized it.

Thanks for the article, I am pretty sure you had originally pointed me at the correct spot. I just didn't know how to make use of it yet.
 
Here is one I used, but just could not get the formatting 100% to marketing's requirements.

On Error Resume Next
'Run this script once and never again
'==========================================================================
Dim varToday, Verify, WhatYouWantToCallIT, LastRun
Set WshShell = CreateObject("Wscript.Shell")

varToday = WhatYouWantToCallIT

Verify = "HKLM\SOFTWARE\MyInstallsAndFixes\"

'Check if scan has run today and if so exit
On Error Resume Next
LastRun = WshShell.RegRead(Verify & "WhatYouWantToCallIT")
If Err.Number = 0 Then
WScript.Quit
Else
WshShell.RegWrite Verify & "WhatYouWantToCallIT", 0,"REG_DWORD"
End If
On Error GoTo 0
'=============================================================================
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)

'The following will be pulled from AD
strName = objUser.FullName
strTitle = objUser.Title
strCompany = objUser.company
strMail = objUser.Mail
strPhone = objUser.telephoneNumber

Set objWord = CreateObject("Word.Application")

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

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

objSelection.Font.Size = "11"
objSelection.Font.Name = "Arial"


objSelection.ParagraphFormat.SpaceAfter = 0
objSelection.TypeText CHR(11)
objSelection.TypeText "Regards,"
objSelection.TypeText CHR(11)
objSelection.TypeText CHR(11)
objSelection.Font.Bold = false
objSelection.TypeText strName
objSelection.Font.Bold = True
objSelection.TypeText CHR(11)
objSelection.Font.Underline = True
objSelection.TypeText strTitle & " "
objSelection.Font.Underline = False
objSelection.Font.Bold = False
objSelection.TypeText CHR(11)
objSelection.Font.Size = "11"
objSelection.Font.Name = "Arial"
objSelection.Font.Bold = False
objSelection.TypeText "Company Name"
objSelection.TypeText CHR(11)
objSelection.Font.Size = "9"
objSelection.Font.Name = "Arial"
objSelection.TypeText "What Company does"
objSelection.TypeText CHR(11)
objSelection.TypeText "Physical address:"
objSelection.TypeText CHR(11)
objSelection.TypeText "some address"
objSelection.TypeText CHR(11)
objSelection.TypeText "some address"
objSelection.TypeText CHR(11)
objSelection.TypeText "Postal address:"
objSelection.TypeText CHR(11)
objSelection.TypeText "Postal address"
objSelection.TypeText CHR(11)
objSelection.Font.Bold = true
objSelection.TypeText "T:"
objSelection.Font.Bold = False
objSelection.TypeText " Phone Number"
objSelection.TypeText CHR(11)
objSelection.Font.Bold = true
objSelection.TypeText "F:"
objSelection.Font.Bold = False
objSelection.TypeText " Phone Number"
objSelection.TypeText CHR(11)
objSelection.Font.Bold = true
objSelection.TypeText "D:"
objSelection.Font.Bold = false
objSelection.TypeText " " & strPhone
objSelection.TypeText CHR(11)
objSelection.Font.Bold = true
objSelection.TypeText "E:"
objSelection.Font.Color = vbBlue
objSelection.Font.Size = "9"
objSelection.Font.Name = "Arial"
objSelection.Font.Bold = false
objSelection.TypeText " " & strMail
objSelection.Font.Underline = False
objSelection.TypeText CHR(11)
objSelection.Font.Color = vbBlack
objSelection.Font.Bold = true
objSelection.TypeText "W:" & " "
objSelection.Font.Bold = false
objSelection.Font.Size = "9"
objSelection.Font.Name = "Arial"
objSelection.Hyperlinks.Add objselection.range, "objSelection.TypeText CHR(11)
objSelection.TypeText CHR(11)
objSelection.Font.Bold = false
objSelection.Font.Size = "8"
objSelection.Font.Name = "Arial"
objSelection.TypeText "To view the e-mail disclaimer please click on the following link"
objSelection.Font.Color = vbBlue
objSelection.Font.Size = "8"
objSelection.Font.Name = "Arial"
objSelection.TypeText " "
objSelection.Font.Color = vbBlack
objSelection.Font.Size = "8"
objSelection.Font.Name = "Arial"
objSelection.TypeText "Should you not have Internet access please send a blank e-mail to "
objSelection.Font.Color = vbBlue
objSelection.Font.Size = "8"
objSelection.Font.Name = "Arial"

objSelection.Hyperlinks.Add objSelection.Range, " " & strHyperlink & " ", , , strHyperlink, "_blank"

objSelection.TypeText " disclaimer@someaddress.com "
objSelection.Font.Color = vbBlack
objSelection.Font.Size = "8"
objSelection.Font.Name = "Arial"
objSelection.TypeText "and our disclaimer will be forwarded to you automatically."
objSelection.TypeText CHR(11)
Set objSelection = objDoc.Range()
objSignatureEntries.Add "Name Signature", objSelection
objSignatureObject.NewMessageSignature = "Name Signature"
objSignatureObject.ReplyMessageSignature = "Name Signature"
objDoc.Saved = True
objWord.Quit
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top