AD Based Outlook Email Signature for 2003 and 2007 Part 4 – Now writes TXT and RTF as well as HTML
Ok due to high demand, and for some very odd reason 2007 was not writing the .txt file and the .rtf.
Now I have implemented various changes so it does this, however due to time constraints its not as
automated as I would like, I will try to review this when I get some free time (hopefully ).
So if you are using the old script the only changes are:
‘=========================================================
‘ This adds the Text file, will need to be changed accordingly
‘==========================================================
Set objFile = objFSO.CreateTextFile(Folderlocation&”Elcom.txt”,True)
objfile.writeLine “”& FullName & ” | ” & title & ” | ” & title & ” | “& Company & ” | Australian Technology Park”
objfile.writeLine “T +612 ” & PhoneNumber & ” | F +612 9209 4423 | www.elcom.com.au | ” & Email &” ”
objfile.writeLine ” ”
objfile.writeLine ” ”
objfile.writeLine “——————————————————————————–”
objfile.writeLine “This email is intended for the intended recipients(s) and may contain confidential information. ”
objfile.writeLine “Reproduction, dissemination or distribution of this message is prohibited unless authorised by the sender.”
objfile.writeLine “If you are not the intended recipient, please notify the sender immediately and you must not read,”
objfile.writeLine “keep, use, disclose, copy or distribute this email without the sender’s prior permission.”
objfile.writeLine “The views expressed by the sender are not necessarily those of Elcom Technology Pty Ltd ”
objFile.Close
as you can see I have had to write this out again (without the HTML tags), this is far from perfect but
it is a working fix for the time being. You will have to edit the above to suite your Text based
Signature.
Next addition is
‘====================================================
‘ This copies the .htm file and changes it to a RTF format
‘====================================================
‘Set the Source and Destination paths below – CHANGE your file name
‘—————————————————-
Const OverwriteExisting = True
Set objFSO = CreateObject(“Scripting.FileSystemObject”)
objFSO.CopyFile Folderlocation & “Elcom.htm” , Folderlocation & “Elcom.rtf”, OverwriteExisting
Being that RTF will show a HTML format this is any easy fix, all you have to do with this is change the
file name which we set in the begining of the script. So for example I would change “Elcom.htm” to
“MyCompany.htm”
Here is the complete code
'====================
'
' VBScript: <Signatures.vbs>
' AUTHOR: Peter Aarts
' Contact Info: peter.aarts@l1.nl
' Version 2.04
' Date: January 20, 2006
' Moddified By Brad Marsh Now works with both 2003 and 2007 outlook
' Contact: gentex@tpg.com.au
' Date 19 feb 08
' Tested on Vista, XP, XP64 and office 2003 and 2007.
' NOTE will not work that well with various email accounts ' Additions added on 20 Nov 08 - Tested on Office 07 and Vista
'====================
'Option Explicit
On Error Resume Next
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
' Read LDAP(Active Directory) information to asigns the user's info to variables.
'====================
Set objSysInfo = CreateObject("ADSystemInfo")
objSysInfo.RefreshSchemaCache
qQuery = "LDAP://" & objSysInfo.Username
Set objuser = GetObject(qQuery)
FullName = objuser.displayname
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 = "http://www.elcom.com.au"
' This section creates the signature files names and locations.
'====================
' Corrects Outlook signature folder location. Just to make sure that
' Outlook is using the purposed folder defined with variable : FolderLocation
' Example is based on Dutch version.
' Changing this in a production enviremont might create extra work
' all employees are missing their old signatures
'====================
Dim objShell, RegKey, RegKey07, RegKeyParm
Set objShell = CreateObject("WScript.Shell")
RegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\General"
RegKey07 = "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Common\General"
RegKey07 = RegKey07 & "\Signatures"
RegKey = RegKey & "\Signatures"
objShell.RegWrite RegKey , "AD_elcom"
objShell.RegWrite RegKey07 , "AD_elcom"
UserDataPath = ObjShell.ExpandEnvironmentStrings("%appdata%")
FolderLocation = UserDataPath &"\Microsoft\AD_elcom\"
HTMFileString = FolderLocation & "Elcom.htm"
' This section disables the change of the signature by the user.
'====================
'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\MailSettings\NewSignature" , "L1-Handtekening"
'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\MailSettings\ReplySignature" , "L1-Handtekening"
'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Options\Mail\EnableLogging" , "0", "REG_DWORD"
' This section checks if the signature directory exits and if not creates one.
'====================
Dim objFS1
Set objFS1 = CreateObject("Scripting.FileSystemObject")
If (objFS1.FolderExists(FolderLocation)) Then
Else
Call objFS1.CreateFolder(FolderLocation)
End if
' The next section builds the signature file
'====================
Dim objFSO
Dim objFile,afile
Dim aQuote
aQuote = chr(34)
' This section builds the HTML file version
'====================
Set objFSO = CreateObject("Scripting.FileSystemObject")
' This section deletes to other signatures.
' These signatures are automaticly created by Outlook 2003.
'====================
Set AFile = objFSO.GetFile(Folderlocation&"Elcom.rtf")
aFile.Delete
Set AFile = objFSO.GetFile(Folderlocation&"Elcom.txt")
aFile.Delete
'=========================================================
' This adds the Text file, will need to be changed accordingly
'==========================================================
Set objFile = objFSO.CreateTextFile(Folderlocation&"Elcom.txt",True)
objfile.writeLine ""& FullName & " | " & title & " | " & title & " | "& Company & " | Australian Technology Park"
objfile.writeLine "T +612 " & PhoneNumber & " | F +612 9209 4423 | www.elcom.com.au | " & Email &" "
objfile.writeLine " "
objfile.writeLine " "
objfile.writeLine "--------------------------------------------------------------------------------"
objfile.writeLine "This email is intended for the intended recipients(s) and may contain confidential information. "
objfile.writeLine "Reproduction, dissemination or distribution of this message is prohibited unless authorised by the sender."
objfile.writeLine "If you are not the intended recipient, please notify the sender immediately and you must not read,"
objfile.writeLine "keep, use, disclose, copy or distribute this email without the sender's prior permission."
objfile.writeLine "The views expressed by the sender are not necessarily those of Elcom Technology Pty Ltd "
objFile.Close
Set objFile = objFSO.CreateTextFile(HTMFileString,True)
objFile.Close
Set objFile = objFSO.OpenTextFile(HTMFileString, 2)
objfile.write "<!DOCTYPE HTML PUBLIC " & aQuote & "-//W3C//DTD HTML 4.0 Transitional//EN" & aQuote & ">" & vbCrLf
objfile.write "<HTML><HEAD><TITLE>Microsoft Office Outlook Signature</TITLE>" & vbCrLf
objfile.write "<META http-equiv=Content-Type content=" & aQuote & "text/html; charset=windows-1252" & aQuote & ">" & vbCrLf
objfile.write "<META content=" & aQuote & "MSHTML 6.00.3790.186" & aQuote & " name=GENERATOR></HEAD>" & vbCrLf
objfile.write "<body>" & vbCrLf
objfile.write "<font color=696969 face=" & aQuote & "Arial" & aQuote & "><h6> "& FullName & " | " & title & " | "& Company & " | Australian Technology Park <br>"& vbCrLf
objfile.write "T +612 " & PhoneNumber & " | F +612 9209 4423 | <a href=http://www.elcom.com.au><font color=#696969>www.elcom.com.au</font></a> |<a href=mailto:" & Email &" > <font color=#696969>" & Email &" " & vbCrLf
objfile.write "</h6></font></a></B>" & vbCrLf
objfile.write "</font>" & vbCrLf
objfile.write "<font color=696969 face=arial><A href=http://www.elcom.com.au/> <img src=http://www.elcom.com.au/images/elcom-logo-web-175x70.gif border=0></a>" & vbCrLf
objfile.write "<br>" & vbCrLf
objfile.write "<img src=http://www.elcom.com.au/images/mspartner.jpg>" & vbCrLf
objfile.write "<br>" & vbCrLf
objfile.write "</font><font color=696969 size=1 face=arial><br>" & vbCrLf
objfile.write "<hr size=1 align=left width=465 color=696969>" & vbCrLf
objfile.write " This email is intended for the intended recipients(s) and may contain confidential information. <br> Reproduction, dissemination or distribution of this message is prohibited unless authorised by the sender.<br> If you are not the intended recipient, please notify the sender immediately and you must not read,<br> keep, use, disclose, copy or distribute this email without the sender's prior permission.<br> The views expressed by the sender are not necessarily those of Elcom Technology Pty Ltd</font>" & vbCrLf
objfile.write "</FONT></BODY></HTML>" & vbCrLf
objFile.Close
'==========================================================================
' This copies the .htm file and changes it to a RTF format
'==========================================================================
'Set the Source and Destination paths below - CHANGE your file name
'----------------------------------------------------
Const OverwriteExisting = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFile Folderlocation & "Elcom.htm" , Folderlocation & "Elcom.rtf", OverwriteExisting
' ===========================
' This section readsout the current Outlook profile and then sets the name of the default Signature
' ===========================
' Use this version to set all accounts
' in the default mail profile
' to use a previously created signature
Call SetDefaultSignature("Elcom","")
' Use this version (and comment the other) to
' modify a named profile.
'Call SetDefaultSignature _
' ("Signature Name", "Profile Name")
Sub SetDefaultSignature(strSigName, strProfile)
Const HKEY_CURRENT_USER = &H80000001
strComputer = "."
If Not IsOutlookRunning Then
Set objreg = GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
strKeyPath = "Software\Microsoft\Windows NT\" & _
"CurrentVersion\Windows " & _
"Messaging Subsystem\Profiles\"
' get default profile name if none specified
If strProfile = "" Then
objreg.GetStringValue HKEY_CURRENT_USER, _
strKeyPath, "DefaultProfile", strProfile
End If
' build array from signature name
myArray = StringToByteArray(strSigName, True)
strKeyPath = strKeyPath & strProfile & _
"\9375CFF0413111d3B88A00104B2A6676"
objreg.EnumKey HKEY_CURRENT_USER, strKeyPath, _
arrProfileKeys
For Each subkey In arrProfileKeys
strsubkeypath = strKeyPath & "\" & subkey
objreg.SetBinaryValue HKEY_CURRENT_USER, _
strsubkeypath, "New Signature", myArray
objreg.SetBinaryValue HKEY_CURRENT_USER, _
strsubkeypath, "Reply-Forward Signature", myArray
Next
Else
strMsg = "Please shut down Outlook before " & _
"running this script."
MsgBox strMsg, vbExclamation, "SetDefaultSignature"
End If
End Sub
Function IsOutlookRunning()
strComputer = "."
strQuery = "Select * from Win32_Process " & _
"Where Name = 'Outlook.exe'"
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
Set colProcesses = objWMIService.ExecQuery(strQuery)
For Each objProcess In colProcesses
If UCase(objProcess.Name) = "OUTLOOK.EXE" Then
IsOutlookRunning = True
Else
IsOutlookRunning = False
End If
Next
End Function
Public Function StringToByteArray _
(Data, NeedNullTerminator)
Dim strAll
strAll = StringToHex4(Data)
If NeedNullTerminator Then
strAll = strAll & "0000"
End If
intLen = Len(strAll) \ 2
ReDim arr(intLen - 1)
For i = 1 To Len(strAll) \ 2
arr(i - 1) = CByte _
("&H" & Mid(strAll, (2 * i) - 1, 2))
Next
StringToByteArray = arr
End Function
Public Function StringToHex4(Data)
' Input: normal text
' Output: four-character string for each character,
' e.g. "3204" for lower-case Russian B,
' "6500" for ASCII e
' Output: correct characters
' needs to reverse order of bytes from 0432
Dim strAll
For i = 1 To Len(Data)
' get the four-character hex for each character
strChar = Mid(Data, i, 1)
strTemp = Right("00" & Hex(AscW(strChar)), 4)
strAll = strAll & Right(strTemp, 2) & Left(strTemp, 2)
Next
StringToHex4 = strAll
End Function
Enjoy
November 20th, 2008 at 12:54 am
Orginal can be found here
http://bradmarsh.wordpress.com/2008/02/18/ad-based-outlook-email-signature-for-2003-and-2007/
November 20th, 2008 at 12:54 am
Part 2 can be found here :
http://bradmarsh.wordpress.com/2008/05/14/ad-based-outlook-email-signature-for-2003-and-2007-continued/
November 20th, 2008 at 12:54 am
Part 3 can be found here:
http://bradmarsh.wordpress.com/2008/05/21/ad-based-outlook-email-signature-for-2003-and-2007-part-3-removing-the-reply-forward-signature/
November 20th, 2008 at 3:33 pm
Fantastic Script and works a treat apart from the Rich text function all I get is raw html being displayed. Any ideas?
November 21st, 2008 at 1:57 am
Hi Paul,
Tht i intresting, for me the RTF seems to display in the same way the HTM file does.
have you ran the abov code with no changes and see what happens, does that give raw code also?
November 21st, 2008 at 10:38 am
Yep ran the code with no changes and I get all the RAW html being displayed as the signature. I am running Office 2007 fully service packed. JUst wondering if anybody else is having the same problem as me.
December 12th, 2008 at 4:01 am
Thanks for the update Brad. I’m looking forward to adding the patch.
Just out of curiousity, you wouldn’t know if it’s possible to do something similar with Out-of-Office replies, would you? That is, we would like to use a common template across the organization for certain holidays.
Again, good work.
December 12th, 2008 at 8:30 am
Hi John,
You know what I have never thought about that, I am sure there is a way you can apply a global template… there has to be. I will see what I can do over the comming days. Sounds like a fun side project.
Brad
December 12th, 2008 at 8:59 am
From a quick look it appers that the out of office is completley client run, and set as exchange rule, the rules are stored within the exchange database…so that being said there is nothing that a VBS script could do with that unfortunatly
I know there are 3rd party tools to do this, but we like free I know this.
Sorry
December 18th, 2008 at 8:50 pm
I am using the script, but i have a problem with it.
A couple of user’s use the script, but it seem’s that when they need to use the RTF file it does NOT show the signature in the e-mail.
Then there is a second thing, sometimes at random moments the signature is just gone…when you go to the options and the 3rd tab and either click cancel OR ok, it show’s the signature again.
Is this common? and how can i change it?
December 18th, 2008 at 8:56 pm
In addition, it appears that when i want to look at it in outlook (as if i was gonna edit it)
It show’s up totally empty…
But when i open the file manually by going to the folder location, then it just show’s what it SHOULD show
December 19th, 2008 at 9:25 am
Hi Nick,
I Have had one other person say they have had problems with the RTF (however this apparently shows as the HTML source, so it does show), this is something I need to look at a little more (will hopfully get to it over the xmas break).
As for the signature disappearing, this is something I have never heard of, nor experianced.
as for your second comment again I have never experiaced this. Which outlook version are you using, is it just you that is exeriancing this or are your other users seeing this too?
January 6th, 2009 at 12:32 am
Hello Brad,
I think the HTML mail is working fine now.
Looks like it doesn’t disappear anymore.
However, the RTF is still not showing, whatever i try.
(Kinda weird)
I am using:
Microsoft Office Outlook 2003 (11.8169.8172) SP3
Other users are seeing (or actually not seeing) the same problem.
Their HTML signature works fine, but their RTF is not showing up.
Would be awesome if your able to fix it
Thanks upfront!
January 6th, 2009 at 12:37 am
Btw, atm i am using:
Set objFSO = CreateObject(“Scripting.FileSystemObject”)
Set objWord = CreateObject(“Word.Application”)
Set objDoc = objWord.Documents.Open(HTMFileString)
objDoc.SaveAs FolderLocation & “Zedek.rtf”, rtf
objDoc.Close
objWord.Quit
Instead of:
Const OverwriteExisting = True
Set objFSO = CreateObject(”Scripting.FileSystemObject”)
objFSO.CopyFile Folderlocation & “Elcom.htm” , Folderlocation & “Elcom.rtf”, OverwriteExisting
Because the last one didn’t work at all.
And this one SHOULD work.
(last one didn’t save as rtf but as rtf with html layout)
This one SHOULD save it as a complete RTF file
January 6th, 2009 at 9:03 am
ver intresting that
Const OverwriteExisting = True
Set objFSO = CreateObject(”Scripting.FileSystemObject”)
objFSO.CopyFile Folderlocation & “Elcom.htm” , Folderlocation & “Elcom.rtf”, OverwriteExisting
didnt work for you.
I will see what I can do with the RTF when I get some spare time. (will hopefully have it for you this week)
January 6th, 2009 at 10:28 pm
Just got another addition for you.
It does create the RTF file, but doesn’t show in Outlook.
So i decided to open it with Words and save it again.
After i did that…it DOES work.
Maybe that’s something of use for you?
And thanks upfront!
January 7th, 2009 at 9:47 am
Hi Nick,
Ok I have the RTF working now, which solves 2 problems for me, the one you have noted nick and the other where it shows the HTML code.
However the downbside is if you have any images they will show as broken images as it does not support or convert images.
The other item is there is mode code changes and use of an exe that must be executed in orer to convert the html to rtf.
I am yet to put it all together which will take a few days (time constraints) but it will come soon.
January 7th, 2009 at 6:03 pm
Hi Brad,
Wow that’s a quick fix.
I’ll be awaiting the code and test it as soon as you put it online.
I have the best hope that there won’t be any other problems.
But if there are, then i will let you know right away.
Thanks Brad!
January 8th, 2009 at 9:36 am
[...] (This is a continuation of http://bradmarsh.net/index.php/2008/11/20/ad-based-outlook-email-signature-for-2003-and-2007-part-4-...) [...]
January 8th, 2009 at 9:37 am
find the new revised code at:
http://bradmarsh.net/index.php/2009/01/08/ad-based-outlook-email-signature-for-2003-and-2007-part-4-now-writes-txt-and-rtf-as-well-as-html-revised/
January 8th, 2009 at 6:17 pm
Brad,
Something is still wrong.
When i do the code like that, it keeps the WINWORD.EXE open all the time.
(it doesn’t save and close it)
Can you still fix that?
January 8th, 2009 at 6:20 pm
Btw, Words should be able to convert html into RTF
January 9th, 2009 at 8:00 am
“Btw, Words should be able to convert html into RTF”
I tried this but it saves the HTML tags… this is what i tried before.
I again dont share your problems but the new code is availbe:
http://bradmarsh.net/index.php/2009/01/08/ad-based-outlook-email-signature-for-2003-and-2007-part-4-now-writes-txt-and-rtf-as-well-as-html-revised/
January 20th, 2009 at 8:55 am
[...] by bradmarsh under Microsoft, Software, Techie, Vista This post has been moved find it: http://bradmarsh.net/index.php/2008/11/20/ad-based-outlook-email-signature-for-2003-and-2007-part-4-... Possibly related posts: (automatically generated)AD Based Outlook Email Signature for 2003 and 2007 [...]
January 22nd, 2009 at 6:54 pm
Hi Brad,
First of thanks a lot for this script. I think this is definately gonna solve my companies problem.
We need to have a standard template for signatures.
So to start of,
1. Is this the latest version of the script.
2. Will i have to use the old script and then append the new one to it, or should i directly use the new one posted up there.
3. How do i add my custom HTML code.
I am not good at html nor m i good in understanding VBS Scripts
But i have my Webadmin who is gonna help me with HTML part.
If you can shed some light on customising the HTML code, that would be great.
Regards,
Abhi
January 22nd, 2009 at 7:04 pm
Hi Abhi,
1. Is this the latest version of the script.
Yes it sure is
2. Will i have to use the old script and then append the new one to it, or should i directly use the new one posted up there.
use this one it is the full script, but this one is a little more involved it depends on what your needs are if you need txt, rtf and HTML support, and you have 2007 and 2003 outlook or just 2007 then use this one if you only need html use the very first post found here
http://bradmarsh.net/index.php/2008/02/18/ad-based-outlook-email-signature-for-2003-and-2007/
this will also write rtf, and txt for 2003 but only HTML for 2007.
3. How do i add my custom HTML code.
follow this post it will guide you through what you need
http://bradmarsh.net/index.php/2008/05/14/ad-based-outlook-email-signature-for-2003-and-2007-continued/
4. ENJOY
April 10th, 2009 at 1:23 am
My fellow on Facebook shared this link with me and I’m not dissapointed that I came here.
July 17th, 2009 at 11:37 am
Traffic exchange is an example of a way to get noticed also. Not sure how many people use them but they still work.
July 30th, 2009 at 2:40 am
So I have using something like this script for a long time. One thing I noticed about this script (and the one I use), is that when you try to reply to a calendar appointment in office 07 you get trash. Using this script, this is what shows up when you try to insert the signature:
“Microsoft Office Outlook Signature | Australian Technology Park T +612 134 | F +612 9209 4423 | http://www.elcom.com.au | me me This email is intended for the intended recipients(s) and may contain confidential information. Reproduction, dissemination or distribution of this message is prohibited unless authorised by the sender. If you are not the intended recipient, please notify the sender immediately and you must not read, keep, use, disclose, copy or distribute this email without the sender’s prior permission. The views expressed by the sender are not necessarily those of Elcom Technology Pty Ltd__”
Now if you take that sig and just resave it in outlook 07 it works just fine. Any guess on how to make it work with outlook 2007 right?
Thanks for your help.
July 30th, 2009 at 2:47 am
Well it’s not letting me post just the text, as it looks like html code. Please try to add a signature to a calendar appointment in 07 and see.
Thanks
August 23rd, 2009 at 3:22 pm
Iwillgive it ago when I get back to work.
Brad
May 17th, 2010 at 2:42 pm
[...] AD Based Outlook Email Signature for 2003 and 2007 Part 4 – Now writes TXT and RTF as well as HTML [...]
May 12th, 2021 at 6:37 am
Dedicated Proxies…
Ok due to high demand, and for some very odd reason 2007 was not writing the .txt file and the .rtf. Now I have implemented various changes so it does this,…
January 13th, 2022 at 8:16 am
2macedon…
…