Outlook Signature Insertion Using Excel VBA

[Anne Troy]

Got the code from Ron de Bruin, but can't seem to make it work. The whole thing was working good so far, though I am not really done with the body. I added the signature in every possible way, but it simply doesn't put my signature in. Yes, the file exists in the path given. He used the "environ" string, but I hard-coded it just to see if that was part of the problem, and it changed nothing.

Function GetBoiler(ByVal sFile As String) As String
'**** Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function


Sub TestFile()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim strbody As String
    Dim SigString As String
    Dim Signature As String


    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup
    For Each cell In Rows("3").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" Then
       ' And _
        '   LCase(Cells(cell.Row, "C").Value) = "yes"
        

            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = "POS Order Update: " & Range("D7").Text & " " & Range("E7").Text
                .Body = "Hi, " & Range("c7").Text & "!" & Chr(10) & Chr(10) & _
                Range("D10").Text & " has been assigned to program your Point of Sale database."
                
                .Display  'Or use Send
                SigString = "C:\Users\atroy\AppData\Roaming\Microsoft\Signatures\AnneTroyHT.htm"

End With
            On Error GoTo 0

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

  Set OutMail = Nothing
        End If
    Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True


End Sub

Help!

 

[RoryA]

Hi Anne,
You haven't appended the Signature string to the Body property. You need to get the signature first and then tack it onto the end of the Body text.

 

[Anne Troy]

Thanks, Rory. I don't do VBA. I just yoink it. Any suggestions as to HOW I append it? I think I understand what you mean, but all the other components have a dot, like .To and such. How do I get it to use SigString?

And how do I get the String FIRST?

 

[RoryA]

Something like this:

Function GetBoiler(ByVal sFile As String) As String
'**** Kusleika
    Dim fso As Object
    Dim ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.readall
    ts.Close
End Function


Sub TestFile()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim strbody As String
    Dim SigString As String
    Dim Signature As String

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
                SigString = "C:\Users\atroy\AppData\Roaming\Microsoft\Signatures\AnneTroyHT.htm"
    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If
    On Error GoTo cleanup
    For Each cell In Rows("3").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" Then
       ' And _
        '   LCase(Cells(cell.Row, "C").Value) = "yes"
        

            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = "POS Order Update: " & Range("D7").Text & " " & Range("E7").Text
                .Body = "Hi, " & Range("c7").Text & "!" & Chr(10) & Chr(10) & _
                Range("D10").Text & " has been assigned to program your Point of Sale database." & vbLf & Signature
                
                .Display  'Or use Send
End With
            On Error GoTo 0

  Set OutMail = Nothing
        End If
    Next cell

cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True


End Sub

 

[Anne Troy]

Will try that when I get in tomorrow, Rory. Thanks TONS.

 

[Anne Troy]

Thanks very much. That gives me a bunch of garbage html code or, if I change it to a TXT signature, I get plain text.

But what it really did was make me realize I don't need to hold up this mini app for a signature. The fact that it creates the email much faster than manually makes it more efficient, even if I have to manually insert my signature using Outlook.

Thanks a ton!!

 

[RoryA]

Is your email being created in HTML, rtf or plain text format?
What you might do, which IMO is easier with sigs, is to create a template email with your signature, then use the Outlook Application's CreateItemFromTemplate method instead.

 

[viktoryeung]

I cant find the filepath Outlook signatures in Office14 (Windows7). Where do I start?

thanks

 

[Anne Troy]

Ron de Bruin is pretty much the VBA email God, and he has some information here:

http://www.rondebruin.nl/mail/folder3/signature.htm

Specifically, this:

In Vista or Win 7 use this

SigString = "C:\Users\" & Environ("username") & _
            "\AppData\Roaming\Microsoft\Signatures\Mysig.txt"

Now, from what I understand, you should change "mysig.txt" to be the desired signature YOU want that exists in that folder. For instance, my sig name is annetroy.txt plain text format or annetroy.rtf for rich text format or annetroy.htm for html format. I don't know how you could actually get the user's file, since that would change according to the user, but perhaps if everyone used the same names for their sigs, such as "mysig" like the code indicates, you could write some VBA for use by everyone.

 

[viktoryeung]

Hi Rorya,
Instead of the .txt signature, is there a way to invoke a user's .htm signature to capture any graphics or formatted text?