Solved

1.Outlook 2010 Email Signature Script

Posted on 2013-06-05
4
616 Views
Last Modified: 2014-05-07
I found this script here on Experts Exchange, see below link.  I have modified much as I can for my use but still need help.  

I need the script to force my signature to be the default Signature for new or replying emails.

Also I would like to block users from tempering with the signature

http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_24114595.html

Any help would be appreciated

Thanks
0
Comment
Question by:David Konig
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
4 Comments
 
LVL 37

Accepted Solution

by:
Jian An Lim earned 500 total points
ID: 39225084
it is a very complex script, I let other to answer it.
but for me, i use regedit to make sure it set

http://www.howto-outlook.com/howto/corporatesignatures.htm

but again, tempering signature is quite a hard one,
because there is no real way to do so, user always able to temper no matter how complex your script is.

This need to make sure your server able to make the tempered signature to avoid editing
i will recommend tool to assist this if it is all about compliance.

http://www.exclaimer.com.au/mail-disclaimers/features
0
 
LVL 76

Expert Comment

by:David Lee
ID: 39225116
Hi, quality4me.

I've added code to the code from the previous question (i.e. the one you linked to above) that should write the signature name to the registry.  You will need to verify the registry path before using this.  To do that

1.  Open Regedit
2.  Navigate to the path Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\9375CFF0413111d3B88A00104B2A6676
3.  Look for the sub-key containing a value called "New Signature"
4.  Edit the const called REG_KEY changing "00000003" to whatever sub-key contains your signature.

' This script is designed to be run from a login script.  It automatically generates
' a HTML file that can be used as an outlook signature in the relevant directory.
' All personal information is pulled from the Active Directory.  This script is
' heavily based on a script first publised by Peter Aarts.

'Edit the registry key path as needed
Const REG_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\Outlook\9375CFF0413111d3B88A00104B2A6676\00000003"
 
'Option Explicit
On Error Resume Next
 
Dim qQuery, objSysInfo, objuser
Dim FullName, Title, Department, Email, PhoneNumber, FaxNumber
Dim FolderLocation, HTMFileString, TXTFileString, RTFFileString
Dim UserDataPath, SigName
 
' 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)
 
SigName = "R&D"
 
FullName = objuser.DisplayName
Title = objuser.Title
Department = objuser.Department
EmailAddr = objuser.Mail
PhoneNumber = objuser.TelephoneNumber
FaxNumber = objuser.FaxNumber
 
' This section creates the signature files names and locations.
'==========================================================================
Dim objShell
Set objShell = CreateObject("WScript.Shell")
UserDataPath = objShell.ExpandEnvironmentStrings("%appdata%")
FolderLocation = UserDataPath & "\Microsoft\Signatures\"
HTMFileString = FolderLocation & SigName & ".htm"
RTFFileString = FolderLocation & SigName & ".rtf"
TXTFileString = FolderLocation & SigName & ".txt"
 
' 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 origianally deleted to other signatures
' that are automatically created by Outlook but I found
' that the rendering engine was rubbish so I create the
' files explicitly.
'==========================================================================
'Set AFile = objFSO.GetFile(Folderlocation&SigName&".rtf")
'aFile.Delete
'Set AFile = objFSO.GetFile(Folderlocation&SigName&".txt")
'aFile.Delete
 
 
' Create HTML sig
Set objFile = objFSO.CreateTextFile(HTMFileString, True)
objFile.Close
Set objFile = objFSO.OpenTextFile(HTMFileString, 2)
 
objFile.Write "<!DOCTYPE html PUBLIC " & aQuote & "-//W3C//DTD HTML 4.01 Transitional//EN" & aQuote & ">" & vbCrLf
objFile.Write "<html>" & vbCrLf
objFile.Write "<head>" & vbCrLf
objFile.Write "<meta http-equiv=" & aQuote & "content-type" & aQuote & " content=" & aQuote & "text/html; charset=ISO-8859-1" & aQuote & ">" & vbCrLf
objFile.Write "<title></title>" & vbCrLf
objFile.Write "</head>" & vbCrLf
objFile.Write "<body>" & vbCrLf
objFile.Write "<table style=" & aQuote & "text-align: left; width: 291pt; color: rgb(0,0,128);" & aQuote & " border=" & aQuote & "0" & aQuote & " cellpadding=" & aQuote & "0" & aQuote & " cellspacing=" & aQuote & "0" & aQuote & ">" & vbCrLf
objFile.Write "<tbody>" & vbCrLf
objFile.Write "<tr style=" & aQuote & " & aQuote & " & aQuote & "font-size: 12pt; font-family: Times New Roman,Times,serif;" & aQuote & ">" & vbCrLf
objFile.Write "<td colspan=" & aQuote & "2" & aQuote & " rowspan=" & aQuote & "1" & aQuote & "><span>" & FullName & "</span>" & vbCrLf
objFile.Write "</td>" & vbCrLf
objFile.Write "</tr>" & vbCrLf
objFile.Write "<tr style=" & aQuote & " & aQuote & " & aQuote & "font-size: 10pt; font-family: Times New Roman,Times,serif;" & aQuote & ">" & vbCrLf
objFile.Write "<td colspan=" & aQuote & "2" & aQuote & " rowspan=" & aQuote & "1" & aQuote & ">" & Title & "</td>" & vbCrLf
objFile.Write "</tr>" & vbCrLf
objFile.Write "<tr style=" & aQuote & " & aQuote & " & aQuote & "font-size: 10pt; font-family: Times New Roman,Times,serif;" & aQuote & ">" & vbCrLf
objFile.Write "<td colspan=" & aQuote & "2" & aQuote & " rowspan=" & aQuote & "1" & aQuote & ">" & Department & "</td>" & vbCrLf
objFile.Write "</tr>" & vbCrLf
objFile.Write "</tr>" & vbCrLf
objFile.Write "<tr style=" & aQuote & " & aQuote & " & aQuote & "font-size: 10pt; font-family: Times New Roman,Times,serif;" & aQuote & ">" & vbCrLf
objFile.Write "<td colspan=" & aQuote & "2" & aQuote & " rowspan=" & aQuote & "1" & aQuote & ">" & EmailAddr & "</td>" & vbCrLf
objFile.Write "</tr>" & vbCrLf
objFile.Write "<tr style=" & aQuote & "font-size: 11pt;" & aQuote & ">" & vbCrLf
objFile.Write "<td colspan=" & aQuote & "2" & aQuote & " rowspan=" & aQuote & "1" & aQuote & "> &nbsp;</td>" & vbCrLf
objFile.Write "</tr>" & vbCrLf
objFile.Write "<tr style=" & aQuote & "font-size: 16pt; font-family: Times New Roman,Times,serif;" & aQuote & ">" & vbCrLf
objFile.Write "<td colspan=" & aQuote & "2" & aQuote & " rowspan=" & aQuote & "1" & aQuote & ">R<small><small>ING </small></small> & <small><small>D<small><small>U</small></small>C<small><small>HATEAU<small></small></td>" & vbCrLf
objFile.Write "<tr style=" & aQuote & "font-size: 11pt; font-family: Times New Roman,Times,serif;" & aQuote & ">" & vbCrLf
objFile.Write "<td colspan=" & aQuote & "2" & aQuote & " rowspan=" & aQuote & "1" & aQuote & "><span>10101 Innovation Drive Suite 200</span> </td>" & vbCrLf
objFile.Write "</tr>" & vbCrLf
objFile.Write "<tr style=" & aQuote & "font-size: 11pt; font-family: Times New Roman,Times,serif;" & aQuote & ">" & vbCrLf
objFile.Write "<td colspan=" & aQuote & "2" & aQuote & " rowspan=" & aQuote & "1" & aQuote & "><span>Milwaukee, WI 53226</span> </td>" & vbCrLf
objFile.Write "</tr>" & vbCrLf
objFile.Write "<tr style=" & aQuote & "font-size: 11pt; font-family: Times New Roman,Times,serif;" & aQuote & ">" & vbCrLf
objFile.Write "<td width=" & aQuote & "10%" & aQuote & ">Phone </td>" & vbCrLf
objFile.Write "<td =" & aQuote & "" & aQuote & ">: " & PhoneNumber & "</td>" & vbCrLf
objFile.Write "</tr>" & vbCrLf
objFile.Write "<tr style=" & aQuote & "font-size: 11pt; font-family: Times New Roman,Times,serif;" & aQuote & ">" & vbCrLf
objFile.Write "<td width=" & aQuote & "10%" & aQuote & ">Fax </td>" & vbCrLf
objFile.Write "<td =" & aQuote & "" & aQuote & ">: " & FaxNumber & "</td>" & vbCrLf
objFile.Write "<tr>" & vbCrLf
objFile.Write "<td colspan=" & aQuote & "2" & aQuote & " rowspan=" & aQuote & "1" & aQuote & "> &nbsp;</td>" & vbCrLf
objFile.Write "</tr>" & vbCrLf
objFile.Write "<tr style=" & aQuote & "font-weight: bold;" & aQuote & ">" & vbCrLf
objFile.Write "<td colspan=" & aQuote & "2" & aQuote & " rowspan=" & aQuote & "1" & aQuote & "><font" & vbCrLf
objFile.Write "color=" & aQuote & "#000000" & aQuote & "><span" & vbCrLf
objFile.Write "style=" & aQuote & "font-size: 7.5pt; font-family: Arial;" & aQuote & ">CONFIDENTIALITY" & vbCrLf
objFile.Write "NOTICE: The information contained within this email is intended for the" & vbCrLf
objFile.Write "addressee only.&nbsp; The message may contain confidential" & vbCrLf
objFile.Write "information, and the wrongful distribution or communication of such" & vbCrLf
objFile.Write "information is prohibited.&nbsp; If you receive this email in error" & vbCrLf
objFile.Write "please notify the sender immediately by reply email and delete the" & vbCrLf
objFile.Write "email including any attachments.<br></span></font>" & vbCrLf
objFile.Write "</td>" & vbCrLf
objFile.Write "</tr>" & vbCrLf
objFile.Write "</tbody>" & vbCrLf
objFile.Write "</table>" & vbCrLf
objFile.Write "<br>" & vbCrLf
objFile.Write "</body>" & vbCrLf
objFile.Write "</html>" & vbCrLf
objFile.Close
 
' Create TXT sig
Set objFile = objFSO.CreateTextFile(TXTFileString, True)
objFile.Close
Set objFile = objFSO.OpenTextFile(TXTFileString, 2)
 
objFile.Write FullName & vbCrLf
objFile.Write Title & vbCrLf
objFile.Write Department & vbCrLf
objFile.Write EmailAddr & vbCrLf
objFile.Write "" & vbCrLf
objFile.Write "Ring & DuChateau" & vbCrLf
objFile.Write "10101 Innovation Drive Suite 200" & vbCrLf
objFile.Write "Milwaukee, WI 53226" & vbCrLf
objFile.Write "Phone : " & PhoneNumber & vbCrLf
objFile.Write "Fax   : " & FaxNumber & vbCrLf
objFile.Write "" & vbCrLf
objFile.Write "" & vbCrLf
objFile.Write "CONFIDENTIALITY NOTICE: The information contained within " & vbCrLf
objFile.Write "this email is intended for the addressee only.  The " & vbCrLf
objFile.Write "message may contain confidential information, and the " & vbCrLf
objFile.Write "wrongful distribution or communication of such information " & vbCrLf
objFile.Write "is prohibited.  If you receive this email in error please " & vbCrLf
objFile.Write "notify the sender immediately by reply email and delete " & vbCrLf
objFile.Write "the email including any attachments." & vbCrLf
 
objFile.Close
 
' Create RTF sig
Set objFile = objFSO.CreateTextFile(RTFFileString, True)
objFile.Close
Set objFile = objFSO.OpenTextFile(RTFFileString, 2)
 
objFile.Write "{\rtf1\ansi\ansicpg1252\deff0\deflang3081{\fonttbl{\f0\froman\fprq2\fcharset0 Times New Roman;}{\f1\fswiss\fprq2\fcharset0 Arial;}}" & vbCrLf
objFile.Write "{\colortbl ;\red0\green0\blue128;\red153\green51\blue153;}" & vbCrLf
objFile.Write "\fs24 " & FullName & "\par" & vbCrLf
objFile.Write "\fs22 " & Title & "\par" & vbCrLf
objFile.Write "\fs22 " & Department & "\par" & vbCrLf
objFile.Write "{\rtf1\ansi\ansicpg1252\deff0\deflang2057{\fonttbl{\f0\froman\fprq2\fcharset0 Times New Roman;}{\f1\fswiss\fcharset0 Arial;}}{\colortbl ;\red0\green0\blue255;}{\*\generator Msftedit 5.41.15.1507;}\viewkind4\uc1\pard\f0\fs20{\field{\*\fldinst{HYPERLINK " & aQuote & "Mailto:" & EmailAddr & aQuote & " }}{\fldrslt{\cf1\ul " & EmailAddr & "}}}\cf0\ulnone\f0\fs20\par\f1\par}" & vbCrLf
objFile.Write "\par" & vbCrLf
objFile.Write "{\*\generator Msftedit 5.41.21.2506;}\viewkind4\uc1\pard\cf1\f0\fs32 R\fs24 ing \fs32 & \fs32 D\fs24 u\fs32 C\fs24 hateau\cf0\par" & vbCrLf
objFile.Write "\fs20 10101 Innovation Drive Suite 200\cf0\par" & vbCrLf
objFile.Write "\fs20 Milwaukee, WI 53226\cf0\par" & vbCrLf
objFile.Write "Phone:\tab " & PhoneNumber & "\par" & vbCrLf
objFile.Write "Fax:\tab " & FaxNumber & "\par" & vbCrLf
objFile.Write " \par" & vbCrLf
objFile.Write "\f1\fs16 CONFIDENTIALITY NOTICE: The information contained within this email is intended for the addressee only.  The message may contain confidential information, and the wrongful distribution or communication of such information is prohibited.  If you receive this email in error please notify the sender immediately by reply email and delete the email including any attachments.\f0\fs24\par" & vbCrLf
objFile.Write "}" & vbCrLf
 
objFile.Close

'Set the signature in the registry
'On the next two lines change "Signature Name" to the name of your signature
WriteValueToRegistry REG_KEY, "New Signature", SigName
WriteValueToRegistry REG_KEY, "Reply-Forward Signature", SigName

                                            
'This code comes from: http://networkadminkb.com/KB/a307/vbscript-ascii2unicodearray.aspx
'********************************************************************
'*
'* Sub ASCII2UnicodeArray
'*
'*   Author: NetworkAdminKB.com
'*  Created: 2007-01-26
'* Modified: 2007-01-26
'*
'* Purpose: Convert any ASCII string to an unicode array/string (VarType
'*            = 8204). A unicode array/string is where each ASCII character
'*            is represented by two values (the ascii char value, and 0).
'*            The unicode "string" also ends in two zeros (0).
'*
'* Input:   strAny = The string to convert to the unicode array
'*
'* Return:  An array of unicode character values (VarType = 8204).
'*
'* Example: ASCII2UnicodeArray("IT") = Array(73, 0, 84, 0, 0, 0)
'*            where 73,00=I and 84,00=T and 0,0 are the ending zeros.
'*
'* Notes: This procedure is can be used with the SetBinaryValue Method
'*          of the StdRegProv Class in WMI write to the Registry.
'*
'********************************************************************
Function ASCII2UnicodeArray(ByVal strAny)
  'Version: 1.0 2007-01-26
  Dim iIndex, iPos
  ReDim aryBytes(Len(strAny) * 2 + 1)
  iIndex = -1
  For iPos = 1 To Len(strAny)
    iIndex = iIndex + 1
    aryBytes(iIndex) = Asc(Mid(strAny, iPos, 1))
    ' add a 0 after each letter
    iIndex = iIndex + 1
    aryBytes(iIndex) = 0
  Next 'iPos
  ' add two closing 0's
  iIndex = iIndex + 1
  aryBytes(iIndex) = 0
  iIndex = iIndex + 1
  aryBytes(iIndex) = 0
  ASCII2UnicodeArray = aryBytes
End Function 'ASCII2UnicodeArray

'This code is a modified version of the code on this Microsoft page: http://msdn.microsoft.com/en-us/library/windows/desktop/aa393286%28v=vs.85%29.aspx
Sub WriteValueToRegistry(strPath, strName, strValue)
    Const HKEY_CURRENT_USER = &H80000001
    Dim objRegistry, uBinary, varReturn
    Set objRegistry = GetObject("Winmgmts:root\default:StdRegProv")
    uBinary = ASCII2UnicodeArray(strValue)
    varReturn = objRegistry.SetBinaryValue(HKEY_CURRENT_USER, strPath, strName, uBinary)
    If (varReturn <> 0) Or (Err.Number <> 0) Then
        MsgBox "There was an error writing the signature name to the registry", vbCritical + vbOKOnly, SCRIPT_NAME
    End If
End Sub

Open in new window

0
 
LVL 1

Author Comment

by:David Konig
ID: 39439338
Hi BlueDevilFan

Sorry for the long break, I had to put the email signature project aside for a few weeks.

I tried working with the code you posted to edit the registry while creating the email signature however I was getting message when loading windows cannot write to registry, I am not sure if it’s because the user is a domain user with no admin rights or something else, but I decided to go the easier way and use the original code and then send out an email to all users with instruction how to make the newly installed Signature the default Signature.

I may try again when time will allow to see if your code will work for me later on, it still will be useful trying because employees change all the time.

Thanks
0
 
LVL 1

Author Comment

by:David Konig
ID: 40047933
Sorry for the long break, under the old Experts-Exchange website there was a confusion about the answer and question therefore I didn’t finalize the topic, it seems to have cleared up now on the new site.

Anyway I am using the Script from the link in my question, the add-on code re the Registry entry did not work for me.

Thanks

David
0

Featured Post

Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

Find out what you should include to make the best professional email signature for your organization.
Finding original email is quite difficult due to their duplicates. From this article, you will come to know why multiple duplicates of same emails appear and how to delete duplicate emails from Outlook securely and instantly while vital emails remai…
The viewer will learn how to look for a specific file type in a local or remote server directory using PHP.
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…

730 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