Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

How can I develop a macro in Outllook 2003 VBA that allows the user to manually add his signature?

Posted on 2008-10-08
10
Medium Priority
?
524 Views
Last Modified: 2012-05-05
I have already created several macro's in Outlook with VBA.  I was just wondering if I can create a macro that the user can run and it inserts the users signature.  I know the file in which the signature is stored, it is stored as a HTML file.  So, I was wondering how I can create this macro?  I would automatically want the signature to append to the bottom of the email.
0
Comment
Question by:navid86
[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
  • 5
  • 3
10 Comments
 
LVL 8

Assisted Solution

by:vsudip
vsudip earned 320 total points
ID: 22669592
0
 
LVL 2

Author Comment

by:navid86
ID: 22670677
Okay.  But, I want to stay away from using Word to insert the signature, some of my users use Word to edit outlook emails and some of them don't, depends on their department.  In the past I have used "SendKey" in VBA to insert a text, string to be specific.  Is there anyway we can simplify the code a bit more, and use a simple function like that.  When I run the code given in the link above, nothing really happends.  Currently in my module I have two other Macro's that use the "SendKey" function, you will see them pasted below also.

So if there is another method to insert the signature that would be awesome, also how come the signature code below does not do anything?

Thanks a lot of your help!
Sub Settlement()
'Settlement purposes - kxs
    Dim str As String
    str = "***for settlement purposes only***without prejudice***"
    SendKeys ("{CAPSLOCK}")
    SendKeys ("^b")
    SendKeys str
    SendKeys ("^b")
    SendKeys ("{ENTER}")
End Sub
 
Sub AttorneyClient()
'Attorney-Client Privilages
    Dim str As String
    str = "***attorney client communication***privileged and confidential***"
    SendKeys ("{CAPSLOCK}")
    SendKeys ("^b")
    SendKeys str
    SendKeys ("^b")
    SendKeys ("{ENTER}")
End Sub
 
Sub InsertMySig()
    Call InsertSig("NXW-FIRM")
End Sub
 
Sub InsertSig(strSigName As String)
    Dim objItem As Object
    Dim objInsp As Outlook.Inspector
    ' requires a project reference to the
    ' Microsoft Word library
    Dim objDoc As Word.Document
    Dim objSel As Word.Selection
    ' requires a project reference to the
    ' Microsoft Office library
    Dim objCB As Office.CommandBar
    Dim objCBP As Office.CommandBarPopup
    Dim objCBB As Office.CommandBarButton
    Dim colCBControls As Office.CommandBarControls
    On Error Resume Next
    
    Set objInsp = Application.ActiveInspector
    If Not objInsp Is Nothing Then
        Set objItem = objInsp.CurrentItem
        If objItem.Class = olMail Then  ' editor is WordMail
            If objInsp.EditorType = olEditorWord Then
                ' next statement will trigger security prompt
                ' in Outlook 2002 SP3
                Set objDoc = objInsp.WordEditor
                Set objSel = objDoc.Application.Selection
                If objDoc.Bookmarks("_MailAutoSig") Is Nothing Then
                    objDoc.Bookmarks.Add Range:=objSel.Range, Name:="_MailAutoSig"
                End If
                objSel.GoTo What:=wdGoToBookmark, Name:="_MailAutoSig"
                Set objCB = objDoc.CommandBars("AutoSignature Popup")
                If Not objCB Is Nothing Then
                    Set colCBControls = objCB.Controls
                End If
            Else ' editor is not WordMail
                ' get the Insert | Signature submenu
                Set objCBP = Application.ActiveInspector.CommandBars.FindControl(, 31145)
                If Not objCBP Is Nothing Then
                    Set colCBControls = objCBP.Controls
                End If
            End If
        End If
        If Not colCBControls Is Nothing Then
            For Each objCBB In colCBControls
                If objCBB.Caption = strSigName Then
                    objCBB.Execute ' **** see remarks
                    Exit For
                End If
            Next
        End If
    End If
    
    Set objInsp = Nothing
    Set objItem = Nothing
    Set objDoc = Nothing
    Set objSel = Nothing
    Set objCB = Nothing
    Set objCBB = Nothing
End Sub

Open in new window

0
 
LVL 2

Author Comment

by:navid86
ID: 22670697
Oh and I did set a refernce to the Word & Office Libraries!
0
Office 365 Training for IT Pros

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

 
LVL 2

Author Comment

by:navid86
ID: 22680052
So, after analyzing the code I still cannot find out why the signature will not run.  On line 24 above my siganture name is an exact match.  Can someone please help me out with this issue.
0
 
LVL 76

Accepted Solution

by:
David Lee earned 1680 total points
ID: 22695400
Hi, navid86.

There are several ways to approach this.  One way is to simulate mouse clicks on the menu selections necessary to insert the signature.  That's the approach used in the code vsudip linked to.  It doesn't depend on Word, it was written to handle Word or Outlook as the editor.  Another approach is to read and insert the signature directly from the signature file.  The code below demonstrates how to do this.

Sub InsertSignature()
    Dim objFSO As Object, _
        objShell As Object, _
        objSignatureFile As Object, _
        olkMsg As Outlook.MailItem, _
        strSigFilePath As String, _
        strBuffer As String
    Set olkMsg = Application.ActiveInspector.CurrentItem
    Set objShell = CreateObject("Wscript.Shell")
    strSigFilePath = objShell.SpecialFolders("Desktop")
    If InStr(1, WinVer(), "Vista") Then
        strSigFilePath = Replace(strSigFilePath, "Desktop", "AppData\Roaming\Microsoft\Signatures\")
    Else
        strSigFilePath = Replace(strSigFilePath, "Desktop", "Application Data\Microsoft\Signatures\")
    End If
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Edit the signature file name on the following line as needed'
    Set objSignatureFile = objFSO.OpenTextFile(strSigFilePath & "BlueDevilFan.htm")
    strBuffer = objSignatureFile.ReadAll
    objSignatureFile.Close
    olkMsg.HTMLBody = olkMsg.HTMLBody & strBuffer
    Set objSignatureFile = Nothing
    Set objFSO = Nothing
    Set objShell = Nothing
    Set olkMsg = Nothing
End Sub
 
Function WinVer() As String
    Dim objShell As Object, strOS As String, strKey As String
    Set objShell = CreateObject("WScript.Shell")
    strOS = objShell.ExpandEnvironmentStrings("%OS%")
    If strOS = "Windows_NT" Then
        strKey = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\"
        WinVer = objShell.RegRead(strKey & "ProductName") & " " & objShell.RegRead(strKey & "CurrentVersion") & "." & objShell.RegRead(strKey & "CurrentBuildNumber")
    Else
        strKey = "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\"
        WinVer = objShell.RegRead(strKey & "ProductName") & " " & objShell.RegRead(strKey & "VersionNumber")
    End If
    Set objShell = Nothing
End Function

Open in new window

0
 
LVL 2

Author Comment

by:navid86
ID: 22702598
Okay, I do think this method is going to work better for me.  I changed the path of my signature on line 14 of the above code you have provided (BlueDevilFan).  I am encountering an error where I put in my signature name on line 18.  The error says "Bad file name or number".  I have pasted my current code below.  I know for a fact that the HTML signature file that I have is the correct name in the code.

I have taken out my domain name below on line 14 for privacy reasons.  I replaced it with asterisk.

Thanks for your help!
Sub InsertSignature()
    Dim objFSO As Object, _
        objShell As Object, _
        objSignatureFile As Object, _
        olkMsg As Outlook.MailItem, _
        strSigFilePath As String, _
        strBuffer As String
    Set olkMsg = Application.ActiveInspector.CurrentItem
    Set objShell = CreateObject("Wscript.Shell")
    strSigFilePath = objShell.SpecialFolders("Desktop")
    If InStr(1, WinVer(), "Vista") Then
        strSigFilePath = Replace(strSigFilePath, "Desktop", "AppData\Roaming\Microsoft\Signatures\")
    Else
        strSigFilePath = Replace(strSigFilePath, "Desktop", "C:\Documents and Settings\NXW.************\Application Data\Microsoft\Signatures")
    End If
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'Edit the signature file name on the following line as needed'
    Set objSignatureFile = objFSO.OpenTextFile(strSigFilePath & "NXW-FIRM.htm")
    strBuffer = objSignatureFile.ReadAll
    objSignatureFile.Close
    olkMsg.HTMLBody = olkMsg.HTMLBody & strBuffer
    Set objSignatureFile = Nothing
    Set objFSO = Nothing
    Set objShell = Nothing
    Set olkMsg = Nothing
End Sub
 
Function WinVer() As String
    Dim objShell As Object, strOS As String, strKey As String
    Set objShell = CreateObject("WScript.Shell")
    strOS = objShell.ExpandEnvironmentStrings("%OS%")
    If strOS = "Windows_NT" Then
        strKey = "HKLM\SOFTWARE\Microsoft\Windows NT\CurrentVersion\"
        WinVer = objShell.RegRead(strKey & "ProductName") & " " & objShell.RegRead(strKey & "CurrentVersion") & "." & objShell.RegRead(strKey & "CurrentBuildNumber")
    Else
        strKey = "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\"
        WinVer = objShell.RegRead(strKey & "ProductName") & " " & objShell.RegRead(strKey & "VersionNumber")
    End If
    Set objShell = Nothing
End Function

Open in new window

0
 
LVL 76

Expert Comment

by:David Lee
ID: 22703391
This (C:\Documents and Settings\NXW.************\Application Data\Microsoft\Signatures) is causing the problem.  The code retrieves the path to the folder where signatures are stored.  Just put in the name of the file (e.g. MySig.htm).
0
 
LVL 2

Author Comment

by:navid86
ID: 22703460
Works Perfect!!!  Thanks a lot of your help and your timely response!
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22703613
You're welcome!  Glad I could help out.
0

Featured Post

Veeam Disaster Recovery in Microsoft Azure

Veeam PN for Microsoft Azure is a FREE solution designed to simplify and automate the setup of a DR site in Microsoft Azure using lightweight software-defined networking. It reduces the complexity of VPN deployments and is designed for businesses of ALL sizes.

Question has a verified solution.

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

Ever wonder what it's like to get hit by ransomware? "Tom" gives you all the dirty details first-hand – and conveys the hard lessons his company learned in the aftermath.
By default Outlook 2016 displays only one time zone in the Calendar. The following article explains how to display two time zones in one calendar view.
Many of my clients call in with monstrous Gmail overloading issues with Outlook. A quick tip is to turn off the All Mail and Important folders from synching. Here is a quick video I made to show you how to turn off these and other folders in Gmail s…
This is my first video review of Microsoft Bookings, I will be doing a part two with a bit more information, but wanted to get this out to you folks.

721 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