# Excel / VBA: Can't Add image to body of outlook msg.



## countryfan_nt (Dec 25, 2022)

Hello friends, Hope all is well! Please help me. The code is supposed to insert an image from a folder and place it in the body
of the email / outlook. I am getting a grey box instead.

Please help me fix the below VBA code.

Thank you Very much in advance!








```
Sub SENDMAIL()
  
Dim rng As Range
Set rngT = Sheets("staff").Range("A1:D1")
' Only send the visible cells in the selection.
Dim pic As String

LR = Sheets("db").Range("H1").Value
Set rng = Sheets("staff").Range("A1:D17118").SpecialCells(xlCellTypeVisible)

    Dim OutApp As Object
    Dim OutMail As Object

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

'Adjust this according to your table gets the last row in the Sheet named "DB" column "A"
    ToAddress = Sheets("DB").Range("f1").Value
pic = "C:\Users\nawaf.altaher\Desktop\Labs\" & Sheets("DB").Range("J1").Value

    On Error Resume Next
    With OutMail
        .To = ToAddress
        .CC = ccAddress
        .BCC = ""
        .Subject = "Medical Insurance Renewal."
       .Attachments.Add pic, 1, 0
       .HTMLBody = "<html><p></p>" & _
                "<img src=""PIC""height=520 width=750>"
                        
      .Display
    On Error GoTo 0

 ' Try to send
    On Error Resume Next
   
    Set OutMail = Nothing
    Set OutApp = Nothing

End With
End Sub
```


----------



## Sequoyah (Dec 25, 2022)

Hi countryfan_nt
try this code, pay attention to the comments I added in  the macro

```
Sub SENDMAIL2()
 'https://www.mrexcel.com/board/threads/excel-vba-cant-add-image-to-body-of-outlook-msg.1225426/
 
Dim rng As Range
Set rngT = Sheets("staff").Range("A1:D1")
' Only send the visible cells in the selection.
Dim pic As String

LR = Sheets("db").Range("H1").Value
Set rng = Sheets("staff").Range("A1:D17118").SpecialCells(xlCellTypeVisible)

    Dim OutApp As Object
    Dim OutMail As Object

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

'Adjust this according to your table gets the last row in the Sheet named "DB" column "A"
    ToAddress = Sheets("DB").Range("f1").Value
MyPath = "C:\Users\nawaf.altaher\Desktop\Labs\" ' <<==== SEPARATE path from File name
pic = Sheets("DB").Range("J1").Value & ".jpg" ' <<==== ADD file extension, adjust if needed

    On Error Resume Next
    With OutMail
        .To = ToAddress
        .CC = ccAddress
        .BCC = ""
        .Subject = "Medical Insurance Renewal."
      .Attachments.Add MyPath & pic, 1, 0 '<<==== Full path + file name + extension
       .HTMLBody = "<html><p></p>" & _
                "<img src='" & pic & " '" & "height=520 width=750>" '<<==== FILE NAME only
                        
      .Display
    On Error GoTo 0

 ' Try to send
    On Error Resume Next
  
    Set OutMail = Nothing
    Set OutApp = Nothing

End With
End Sub
```


----------



## countryfan_nt (Dec 26, 2022)

Sequoyah said:


> Hi countryfan_nt
> try this code, pay attention to the comments I added in  the macro
> 
> ```
> ...


Now that's awesome! Really appreciate it, btw your description and comments made ONE huge difference!


----------



## Sequoyah (Dec 26, 2022)

Hi, thanks for the feedback, you can mark the thread as solved


----------

