VBA code-Signature code failure

[khaledocom]

The bellow code shows Excel VBA code to make signature for outlook 2007 outgoing messages.
It works properly but doesn't show the picture in signature (Pic is not appearing). Can you help with this regarding.


<table width="560" border="0" cellpadding="0" cellspacing="0"><col style="width: 42pt;" width="56" span="10"> <tbody><tr style="height: 15.75pt;" height="21"> <td colspan="10" class="xl22" style="height: 15.75pt; width: 420pt;" width="560" height="21">The pic (photo) in my signature doesn't appear when I use signature code</td> </tr> <tr style="height: 15.75pt;" height="21"> <td colspan="10" class="xl22" style="height: 15.75pt;" height="21">It show only red X on top.
</td> </tr> </tbody></table>
Code:

Function GetBoiler(ByVal sFile As String) As String

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 Mail_Outlook_With_Signature_Plain()

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim SigString As String
Dim Signature As String

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strbody = "Go for test mode of Qtel billing and recovery"





SigString = "C:\Documents and Settings\" & Environ("username") & _
"\Application Data\Microsoft\Signatures\Khaledo.htm"


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

On Error Resume Next
With OutMail
.To = "khaledocom@yahoo.com"
.CC = ""
.BCC = ""
.Subject = "Test Mode"
.HTMLBody = strbody & "<br><br>" & Signature

.Send
End With

On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
End Sub


I'm very thankful for your help and support.

 

[khaledocom]

What did you do which made it work?

It might be useful to someone else in the future.

Yes Ruddles,
I changed the path or link to the picture in the html page using notepad then saved the page.

 

[khaledocom]

No, this was a totally different issue.

 

[kato223]

I know that you may have an answer to this, but I have found a very easy way to insert the default signature into an e-mail with VBA so that the images in your signature show up.

1. After creating your signature, create an e-mail that is showing your signature in it. Then SaveAs, and Save as type: Outlook Template, and give it a name, maybe like 'MyDefaultTemplate' and save it to a location that you can find it. I saved mine in my UserProfile folder. The file will have an .oft extension.

Put the following in your code. I like to use the Environ("UserProfile") so that I don't have to specify the directory the user has, especially between Windows XP and Windows 7, where Windows XP is "C:\Documents and Settings\username\" and Windows 7 is "C:\Users\username\":

    EmailTemplate = Environ("UserProfile") & _
        "\MyDefaultTemplate.oft"

The with your OutMail line that creates the e-mail, use this code instead:

Set OutMail = OutApp.CreateItemFromTemplate(EmailTemplate)

Also make sure that you have .BodyFormat = olFormatHTML in your With OutMail section:

With OutMail
        .BodyFormat = olFormatHTML
        .HTMLBody = "What ever you are sending in this e-mail"
        .Display
End With

Hope this helps saving headaches with a lot of unnecessary code. No more need for GetBoiler.

Here is my entire code, and I have included the functions as well:

Sub Mail_Sheet_Outlook_Body()
' You need to use this module with the RangetoHTML subroutine.  You also need to use the LastRow subroutine.
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
    Dim rng As Range
    Dim rng2 As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim Last1 As Long
    Dim Last2 As Long
    
    ' Get the Last Rows of Each sheet
    Last1 = LastRow(Sheets("Tech"))
    Last2 = LastRow(Sheets("WorkReport"))
    
    ' Setup Default Signature
    EmailTemplate = Environ("UserProfile") & _
        "\MyDefaultTemplate.oft"
   
    ' Disable screen updating
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
 
    ' Clear ranges first, then set new ranges
    Set rng = Nothing
    Set rng2 = Nothing
    Set rng = Sheets("Tech").Range("A1:G" & Last1)
    Set rng2 = Sheets("WorkReport").Range("A1:H" & Last2)

    ' Get To: and CC: fields
    to_ = Sheets("Recipients").Range("A2")
    cc_ = Sheets("Recipients").Range("A5")
    
    
    ' Start e-mail creation
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItemFromTemplate(EmailTemplate)
 
    On Error Resume Next
    With OutMail
        .To = to_
        .CC = cc_
        .BCC = ""
        .Subject = "Daily Tech Ticket Report - " & Date
        .BodyFormat = olFormatHTML
        .HTMLBody = "<span style=""font: 11pt Calibri"">Hello Tech Team," & vbNewLine & vbNewLine & "Please review and apply focus to resolving these aging tickets." _
            & RangetoHTML(rng) _
            & "<br><br><span style=""font: 22pt Calibri""><b><u>Tech aging Tickets:</b></u></span>" _
            & RangetoHTML(rng2)

        ' In place of the following statement, you can use ".Display" to
        ' display the e-mail message.
        .Send
           
    End With
    On Error GoTo 0
 
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
 
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub


Function RangetoHTML(rng As Range)
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
 
    ' Copy the range and create a workbook to receive the data.
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
 
    ' Publish the sheet to an .htm file.
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
 
    ' Read all data from the .htm file into the RangetoHTML subroutine.
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
 
    ' Close TempWB.
    TempWB.Close savechanges:=False
 
    ' Delete the htm file.
    Kill TempFile
 
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function


Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(what:="*", _
                            after:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

 

[adavid]

In the .htm file in the signatures directory you can edit the htm file. The pictures are stored as relative path and when you use the code it looses that path so if you use discrete path it will be able to find the pictures. so go into the file and look for any relative paths and make them discrete.

"/Microsoft/Signatures/picturefile.jpg"

change that to include the whole path

"/root/user/blah blah../Microsoft/Signatures/picturefile.jpg"

This solved the missing image problem for me.

Yes, it is. the full path for the file:

C:\Documents and Settings\" & Environ("username") & _
"\Application Data\Microsoft\Signatures\Khaledo.htm