Solved

1.Outlook 2010 Email Signature Script

Posted on 2013-06-05
4
547 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:D. Konig
  • 2
4 Comments
 
LVL 36

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:D. 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:D. 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

Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

Join & Write a Comment

Granting full access permission allows users to access mailboxes present in their database. By giving full access permission one can open and read the content of any mailbox but cannot send emails from that mailbox.
Is your Office 365 signature not working the way you want it to? Are signature updates taking up too much of your time? Let's run through the most common problems that an IT administrator can encounter when dealing with Office 365 email signatures.
The viewer will learn how to dynamically set the form action using jQuery.
The viewer will learn how to create and use a small PHP class to apply a watermark to an image. This video shows the viewer the setup for the PHP watermark as well as important coding language. Continue to Part 2 to learn the core code used in creat…

744 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now