We help IT Professionals succeed at work.

We've partnered with Certified Experts, Carl Webster and Richard Faulkner, to bring you two Citrix podcasts. Learn about 2020 trends and get answers to your biggest Citrix questions!Listen Now

x

Outlook Signature Script

ShayneBeaumont
on
Medium Priority
1,941 Views
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

BUT
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")
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
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
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&"xxx.rtf")
aFile.Delete
Set AFile = objFSO.GetFile(Folderlocation&"xxx.txt")
aFile.Delete
 
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 "<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
objFile.Close
 
 
' ===========================
' 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 & _
"\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

Open in new window

Comment
Watch Question

David BeveridgeLinux Systems Admin
CERTIFIED EXPERT

Commented:
Can you set the registry permission to stop them from add a reply sig.
See
http://www.lockergnome.com/windows/2005/01/11/set-registry-permissions-using-group-policy/

Author

Commented:
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.
Linux Systems Admin
CERTIFIED EXPERT
Commented:

Not the solution you were looking for? Getting a personalized solution is easy.

Ask the Experts
Access more of Experts Exchange with a free account
Thanks for using Experts Exchange.

Create a free account to continue.

Limited access with a free account allows you to:

  • View three pieces of content (articles, solutions, posts, and videos)
  • Ask the experts questions (counted toward content limit)
  • Customize your dashboard and profile

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.