Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium


Outlook Signature Script

Posted on 2009-02-16
Medium Priority
Last Modified: 2012-05-06
I have a signature script bellow that works great. It loads a login and stops users changing the company signature to what ever they wish.
I want to add a line to the script that will make the reply forward signature change to <none> so I dont have the signature on replies.
I know ther are other ways like a bat file
reg delete "HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\9375CFF0413111d3B88A00104B2A66760000001" /v "Reply-Forward Signature" /f

I need this in the script so users cant add a reply signature and it iverwrites eeach time they login.

'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")
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
MobileNumber = objuser.TelephoneMobile
OfficeLocation = objuser.physicalDeliveryOfficeName
StreetAddress = objuser.streetaddress
CityAddress = objuser.l
StateAddress = objuser.st
PostofficeBox = objuser.postofficebox
Department = objUser.Department
ZipCode = objuser.postalcode
web_address = "http://www.xxx.com"
' 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_xxx"
objShell.RegWrite RegKey07 , "AD_xxx"
UserDataPath = ObjShell.ExpandEnvironmentStrings("%appdata%")
FolderLocation = UserDataPath &"\Microsoft\AD_xxx\"
HTMFileString = FolderLocation & "xxx.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
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&"xxx.rtf")
Set AFile = objFSO.GetFile(Folderlocation&"xxx.txt")
Set objFile = objFSO.CreateTextFile(HTMFileString,True)
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 "<table cellspacing=0 cellpadding=0>"
objfile.write "<tr><td>"
objfile.write "<p align=left><B><FONT style=font-size:10pt color=808080 face=Verdana>" & FullName & "</B> | " & title & "<br>"& vbCrLf
objfile.write "<B><FONT style=font-size:20pt color=#00539B  face=Verdana> xxx</B></font><font color=78BDE8 style=font-size:20pt face=Verdana>xxx<br>"& vbCrLf
objfile.write "</font><font color=808080 style=font-size:2pt face=Verdana><br>" & vbCrLf
objfile.write "</font><font color=808080 style=font-size:8pt face=Verdana>" & Company & "<br>"& vbCrLf
objfile.write " " & StreetAddress & ", " & CityAddress & " " & StateAddress & " " & ZipCode & "<br>"& vbCrLf
if PostofficeBox <> "" then
	objfile.write " (" & PostofficeBox & ")<br>" & vbCrLf
end if
objfile.write "<nobr>T " & PhoneNumber & " | F " & FaxNumber
if MobileNumber <> "" then
	objfile.write " | M " & MobileNumber
end if
objfile.write "<br>" & vbCrLf
objfile.write "<a href=" & Email &" > <font color=#696969 face=Verdana>" & Email &"</a> | <a href=http://www.xxx.com><font color=#696969>www.xxx.com</font></a>"& vbCrLf
objfile.write "</td><td align=right>"
objfile.write "<img src=\\xxx.local\sysvol\xxx.local\scripts\anniversary.jpg ALIGN=RIGHT BORDER=0 WIDTH=316 HEIGHT=89>"
objfile.write "</td></tr></table>"
objfile.write "<font color=808080 style=font-size:7pt face=Verdana><br>" & vbCrLf
objfile.write " This transmission is for the intended addressee only. If you have received this transmission in error, please delete it and notify the sender.<br>"  & vbCrLf
objfile.write "</FONT></BODY></HTML>" & vbCrLf
' ===========================
' 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("Orient","")
' 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 & _
objreg.EnumKey HKEY_CURRENT_USER, strKeyPath, _
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
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
IsOutlookRunning = False
End If
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))
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)
StringToHex4 = strAll
End Function

Open in new window

Question by:ShayneBeaumont
  • 2
LVL 19

Expert Comment

ID: 23655932
Can you set the registry permission to stop them from add a reply sig.

Author Comment

ID: 23655972
I want to do it in a script as there are many different settings on numerous PC's.

I could use a GPO but I really just need the script I have edited.

If there are any VBS  guru's that can help.
LVL 19

Accepted Solution

bevhost earned 2000 total points
ID: 23655990

Featured Post

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If you have a multi-homed DNS setup in windows, you can have issues with connectivity to the server that hosts the DNS services (or even member servers of your domain if this same DNS server is a DC). This is because windows registers all of its IPs…
There have been a lot of times when we have seen the need to enter a large number of DNS entries in a forward lookup zone. The standard procedure would be to launch the DNS Manager console, create the Zone and start adding new hosts using the New…
Exchange organizations may use the Journaling Agent of the Transport Service to archive messages going through Exchange. However, if the Transport Service is integrated with some email content management application (such as an anti-spam), the admin…
As many of you are aware about Scanpst.exe utility which is owned by Microsoft itself to repair inaccessible or damaged PST files, but the question is do you really think Scanpst.exe is capable to repair all sorts of PST related corruption issues?
Suggested Courses

564 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question