Error when trying to embed picture into HTMLBody in email - Excel VBA to Outlook

[espenskeie]

Hi

I just cant get this working, and I cannot see why....

I try to set the image address like this:
(With an extra space after <)

s = "< img src=" & DesktopOpen & "\XYZ\" & "DailyReport " & Stamp & ".GIF" & " > """

Sub Mail()


' Denne skal passe til Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010,
' Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
    
    Dim rng As Range
    Dim Stamp As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sFileName As String
    Dim preStrBody As String
    Dim sFileName1 As String
    Dim postStrBody As String
    Dim DesktopOpen As String
    
    
    Set rng = Nothing
    On Error Resume Next
    'Only the visible cells in the selection
    Set rng = Sheets("Indigosec morning notes").Range("A1:M67").SpecialCells(xlCellTypeVisible)
    'You can also use a range if you want
    'Set rng = Sheets("YourSheet").Range("D4:D12").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0


    'Setter adressen til folderen som skal legges på skrivebordet
    DesktopOpen = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    
    'Denne gir PDF-fila dagens dato
    Stamp = Format(Date, "DD.MM.YYYY")
    
    Sheets("SetUp").Activate
    
    'Adresse og navn til filen som skal være vedlagt
    sFileName = DesktopOpen & "\XYZ\Rapport_" & Stamp & ".pdf"
    
    'Om ønskelig en ekstrafil vedlagt?
    sFileName1 = DesktopOpen & "\XYZ\DailyReport " & Stamp & ".GIF"
    On Error Resume Next
   
For Each cell In Sheets("SetUp").Columns("C").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "D").Value) = "yes" Then
           
   Set OutApp = CreateObject("Outlook.Application")
   Set OutMail = OutApp.createitem(0)
   
        preStrBody = "[FONT=calibri]" & _
                     "God børsdag " & Cells(cell.Row, "A").Value & "

" & _
                     "Vedlagt følger morgenrapporten fra vår analyseavdeling. " & _
                     "Håper du finner informasjonen som bla bla bla. " & "

" & _
                     "Best regards / Med vennlig hilsen" & "

" & _
                     "Preben Livang" & "

" & _
                     "CEO & founder of Indigo Sec" & "
" & _
                     "Indigo Sec" & "

" & _
                     "Indigo Sec
" & _
                     "

"
                     
   's = "[/FONT]
Hourly US GMV Chart
" & vbNewLine
   'img src='c:\folder\filename.png'
   
    s = "[IMG]http://www.mrexcel.com/forum/"DesktopOpen & "\XYZ\" & "DailyReport " & Stamp & ".GIF" [/IMG] """
    's = s & "Bye...
"


    postStrBody = "..................................................." _
                    & "

" & _
                    "CONFIDENTIALITY NOTICE:  This email is intended only for the person or entity to which it is addressed and may contain " & _
                    "confidential and/or privileged material. Delivery of this email or any of the information contained herein to anyone other than " & _
                    "the intended recipient or his designated representative is unauthorized and any other use, reproduction, distribution or " & _
                    "copying of this document or the information contained herein, in whole or in part, without the prior written consent of sender " & _
                    "or its affiliates is prohibited and may be unlawful. Any performance information contained herein may be unaudited and " & _
                    "estimated. Past performance is not necessarily an indication of future performance. If you have received this message in " & _
                    "error, please notify the sender immediately and delete this message and any related attachments. " _
                    & "

" & _
                    "..................................................." & ""
                
               ' Dette feltet sier seg selv....
                With OutMail
                    .To = cell.Value 'Scanner igjennom lista og sender privat mail, en mail pr adresse,
                                     ' slik at det ikke er nødvendig med .BCC
                    .cc = ""
                    .BCC = ""
                    .Subject = "Morning notes" & Stamp & ", Indigo Sec"
                    .HTMLBody = preStrBody & s & postStrBody
                                
                    .Attachments.Add (sFileName)
                    .NoAging = True
                    'Legge til en ekstrafil?? Ta bort ' på neste linje og sjekk øverst at det faktisk blir laget (eller allerede eksisterer en fil med dette navnet)
                    .Attachments.Add (sFileName1)
                    ' Tallet i parantes forteller hvilken konto du sender fra
                    .SendUsingAccount = OutApp.Session.Accounts.Item(2)
                    
                    .Display
                End With
                
                On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
        Application.Wait (Now + TimeValue("0:00:02"))
        SendKeys "%{s}", True 'Denne overstyrer varselboksen om at noen forsøker å sende en mail fra Outlook
            
            End If
Next cell


End Sub

When the email open, I see only a box with red cross inside... Obviously no picture there...

Kind regards
Espen

 

[Domenic]

First you'll need to attach the image to the email, and then you'll need to exclude the path from the image filename and prepend "cid:" to it, as per Post #7 in the following thread...

http://www.mrexcel.com/forum/excel-...te-image-folder-outlook-mail.html#post3251692

 

[espenskeie]

Thank Domenic, I've been seeing your name on many threads when seaching... I have little problem, the picture will change name every day, how can I make it dynamic?

Stamp = Format(Date, "DD.MM.YYYY")
sFileName1 = DesktopOpen & "\XYZ\DailyReport " & Stamp & ".GIF"
.Attachments.Add (sFileName)
                    .Attachments.Add (sFileName1)
                    .HTMLBody = preStrBody &"Ximg src=""cid:" & "DailyReport " & Stamp & ".GIF"" X " & postStrBody"

Kind regards
Espen

 

[espenskeie]

It seems that the open space in my string is causing the errors, I have given the pictures names and date separated with an open space: DailyReport 04.09.2012. It works fine if I leave the open space....

Thank you for the tip and link that helped me getting to the solution

Kind regards
Espen

 

[Domenic]

That's great. I'm glad you've sorted it out. By the way, you can always use an underscore instead...

DailyReport_04.09.2012

 

[espenskeie]

Thanks Domenic, I did try that and it now seem to work fine. I guess leaving spaces in filenames isn't a good idea.