More Outlook Resource Sites

Microsoft Developer Network (MSDN)

FAQs and other general resources

share code 27-Nov-2014 16:38

Looking for help with Outlook programming projects — VSTO, add-ins, VBA, custom Outlook forms, etc.? You′ve come to the right place!

NEW! >> Subscribe to this site via RSS. For more RSS options, see the complete list of feeds on our main news page.

Login Password
Remember me
Register | Send my password
Code level: advanced    Code area: Outlook Expert Techniques Printer Friendly Version
Title: Set email account signature in Outlook 2003
Description: Outlook 2003 makes it particularly difficult to set the signature for new messages and replies/forwards because each mail account has its own signature. This sample script uses the Windows Management Instrumentation (WMI) interface and something of a "brute force" approach to set a signature on all services, even those that aren't email accounts.
Date: 30-Mar-2005  02:10
Code level: advanced
Code area: Outlook Expert Techniques
Posted by: Sue Mosher
This message is displayed as VB.NET
 ' Use this version to set all accounts
' in the default mail profile
' to use a previously created signature
Call SetDefaultSignature("Signature Name", "")

' 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
            'On Error Resume Next
            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
All 101comments
Page [ 1 2 3 4 5 6 7 8 9 10 Next >>  
  30-Mar-2005  10:16   
NOTES:

1) This technique is officially unsupported. The only supported methods for modifying profile settings are Extended MAPI programming (which can't be scripted) and .prf files, which can't dig deeply enough into the profile settings to set signatures.

2) This sample sets both the new and reply/forward signatures. You might want to modify it to change only one or the other.

For a good introduction to WMI scripting, see http://msdn.microsoft.com/library/en-us/dnclinic/html/scripting06112002.asp

For another WMI script to set the Outlook Address Book display order to Last, First, see http://www.outlookcode.com/codedetail.aspx?id=804
  08-Apr-2005  11:50   
Don't forget to change "Signature Name" to the actual name of the signature you want or "" if you want no signature.
  14-Apr-2005  11:27   
Sue, how can you set it so that if there is no Outlook profile that it will just exit out of the script and not error out.
  15-Apr-2005  08:04   
You mean if the user has never run Outlook at all? I guess that after the first If strProfile = "" block, you could add another:

If strProfile = "" Then
    Exit Sub
End If
  01-Jun-2005  13:50   
The KB article at http://support.microsoft.com/?kbid=898076 describes a post SP1 hotfix for Outlook and Word 2003. If you apply it, delete the First-Run value as described in the article, and then set NewSignature and ReplySignature REG_SZ (string) values in the HKEY_CURRENT_USER\Software\Policies\Microsoft\Office\11.0\Common\MailSettings key to the name of the desired signature, that signature will be the default for all accounts, and the user won't be able to change that default.
  17-Jun-2005  21:26   
Is there a way to modify this code to automatically cycle through all the available signatures?
  01-Jul-2005  11:32   
Stuart, all the available signatures would be stored as filed in the user's Signatures folder, if that's what you're asking.
  14-Sep-2005  08:13   
Note that this script is from my book, "Configuration Microsoft Outlook 2003." You can get more information on the book at http://www.turtleflock.com/olconfig/index.htm
  17-Oct-2005  11:49   
The fix mentioned in my 01-Jun-2005 post has been incorporated into Office 2003 Service Pack 2 (SP2).
  30-Nov-2005  07:17   
Hi the script works great. I don't have a lot of scripting knowledge but my company wants the first and lastname and department of the user in the signature as well. Is this posible? Is there a way to retreive this with LDAP from the AD?
Page [ 1 2 3 4 5 6 7 8 9 10 Next >>