Insert picture to email body from the embedded object in excel

Vincent88

Active Member
Joined
Mar 5, 2021
Messages
382
Office Version
  1. 2019
Platform
  1. Windows
  2. Mobile
I use a code to embed image to excel (this part works fine), then how can I insert that image to an email body. Also I want to copy the text from column A of relative row (if I am in E3, then I want to copy A3 text) for the subject of email.

VBA Code:
Sub SelectOLE()
Dim objFileDialog As Office.FileDialog

    Set objFileDialog = Application.FileDialog(MsoFileDialogType.msoFileDialogFilePicker)

        objFileDialog.AllowMultiSelect = False
        objFileDialog.ButtonName = "Select File"
        objFileDialog.Title = "Select File"
        objFileDialog.Show

        If (objFileDialog.SelectedItems.Count > 0) Then
                    
        Set f = ActiveSheet.OLEObjects.Add _
            (Filename:=objFileDialog.SelectedItems(1), _
              Link:=False, _
              DisplayAsIcon:=True, _
              IconLabel:=objFileDialog.SelectedItems(1), _
              Top:=ActiveCell.Top, _
              Left:=ActiveCell.Left _
           )
        f.Select
        
        With f
       .ShapeRange.LockAspectRatio = msoFalse
       .Width = ActiveCell.Width
       .Height = ActiveCell.Height
        End With
        
          'f.Width = ActiveCell.Width
          'f.Height = ActiveCell.Height
      
        End If
        EmailChase
End Sub
Sub EmailChase()
    If ActiveWorkbook Is ThisWorkbook Then
    
       Dim ws As Worksheet
       Set ws = ActiveSheet
      
       Dim emailApplication As Object
       Dim emailItem As Object

       Set emailApplication = CreateObject("Outlook.Application")
       Set emailItem = emailApplication.CreateItem(0)
      
       Dim sp, ep As String
       sp = "<p style='font-family:Tahoma;font-size:10pt;mso-margin-top-alt:0.0pt;margin-bottom:0.0pt'>"
       ep = "</p><br>"
  
      
       strbody = sp & "Dear Francis," & ep _
                 & sp & "User chases this case. Please review." _
                 & sp & "<br>" _
                 & ep
       'Now insert the embedded picture here
                
       On Error Resume Next
      
       With emailItem
           .Display
           .To = "testingsample@gmail.com"
           '.CC = sh.Range("P2").Value
           '.BCC = sh.Range("Q2").Value
          
           '.Subject = ws.Range("a2").Text
           .Subject = ws.Range(Cells(Rows(), 1)).Text
          
           .HTMLBody = strbody & .HTMLBody
                            
      
        End With
        
        On Error GoTo 0

        Set emailItem = Nothing
        Set emailApplication = Nothing

    End If
    
End Sub
 
Hi HaHoBe,
To achieve the default signature, just add & . HTMLBody at the end of your code :
.HTMLBody = "<html><p>" & strBody & "</p><img src=""cid:" & strPic & """ width='80%'></html>" & .HTMLBody

Many thanks.

If I want to write code to insert signature manually, I want to insert two logo images (one of them is a hyperlink at the end of my text. Please review my code if it works or not !

VBA Code:
.HTMLBody = "<html><p>" & strBody & "</p><img src=""cid:" & strPic & """ width='80%'></html>" _
            & sp & "<b>" & "Regards" & "</b>" _
            & sp & ws.Range("B" & ActiveCell.Row).Text _
            & sp & "<b>" & "HelpAgent" & "</b>" _
            & sp & "Powerman Corporate LLC." _
            & sp & "<A href=""mailto:it-helpagent@powerman.com"">it-helpagent@powerman.com</A>" _
            & sp & "<img src="C:\Users\vincent88\AppData\Roaming\Microsoft\Signatures\PWR_files\image001.png"/>" _
            & sp & "<A href=https://www.mrexcel.com/board"">"<img src="C:\Users\vincent88\AppData\Roaming\Microsoft\Signatures\PWR_files\image002.png"/>"</A>"
 
Upvote 0

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Hi Vinecent88,

Please review my code if it works or not !

If I paste the code into the VBE shows red - something´s wrong. So the answer to your question: no, it does not work. Is anything wrong with the code I supplied as you try to solve the problem in a different way from that?

A new procedure as both the pictures in the signature are handled as constants. Is it always the same person you mail to as the name is hardcoded?
VBA Code:
Sub EmailChase3(lngRow As Long)

Dim ws As Worksheet
Dim emailApplication As Object
Dim emailItem As Object
Dim sp As String, ep As String, strBody As String
Dim strFilePic As String
Dim strPic As String

Const cstrImg1 As String = "C:\Users\vincent88\AppData\Roaming\Microsoft\Signatures\PWR_files\image001.png"
Const cstrSh1 As String = "image001.png"
Const cstrImg2 As String = "C:\Users\vincent88\AppData\Roaming\Microsoft\Signatures\PWR_files\image002.png"
Const cstrSh2 As String = "image002.png"

If ActiveWorkbook Is ThisWorkbook Then
Set ws = ActiveSheet
Set emailApplication = CreateObject("Outlook.Application")
Set emailItem = emailApplication.CreateItem(0)

sp = "<p style='font-family:Tahoma;font-size:10pt;mso-margin-top-alt:0.0pt;margin-bottom:0.0pt'>"
ep = "</p><br>"

strBody = sp & "Dear Francis," & ep _
& sp & "User chases this case. Please review." _
& sp & "<br>" _
& ep

strFilePic = ws.Cells(lngRow, 5).Value 'please adjust the column to suit your needs, here it`s Column E
strPic = Mid(strFilePic, InStrRev(strFilePic, "\") + 1)

On Error Resume Next
With emailItem
.Display
.To = "testingsample@gmail.com"
.Subject = ws.Cells(lngRow, 1).Text
.Attachments.Add strFilePic, 1, 0
.Attachments.Add cstrImg1, 1, 0
.Attachments.Add cstrImg2, 1, 0

.HTMLBody = "<html><p>" & strBody & "</p><img src=""cid:" & strPic & """ width='80%'></html>" _
& ep & sp & "<b>" & "Regards" & "</b>" _
& sp & ws.Range("B" & ActiveCell.Row).Text _
& ep & sp & "<b>" & "HelpAgent" & "</b>" _
& sp & "Powerman Corporate LLC." _
& ep & sp & "<A href=""mailto:it-helpagent@powerman.com"">it-helpagent@powerman.com</A>" _
& ep & sp & "<img src=""cid:" & cstrSh1 & """width='80%'/>" _
& ep & sp & "<A href=""mailto:it-helpagent@powerman.com""><img src=""cid:" & cstrSh2 & """width='80%'/></A>"
End With

On Error GoTo 0

Set emailItem = Nothing
Set emailApplication = Nothing

End If

End Sub
I testeed with pictures in a different place than you indicated but it worked for me. You would maybe need to alter the measures for width for the images as I gave them 80% as with the picture inserted via the worksheet path.

Ciao,
Holger
 
Upvote 0
Hi HaHoBe,
After I posted the request, I modified mine and it works. The two images' size display as is without distortion.
Is it possible to change the image path like %appdata%\Microsoft\Signatures\PWR_files\image002.png ? cos this excel file is sharing with other colleagues.
Your code works also but needs to keep sizes as original
VBA Code:
& sp & "<img src= 'C:\Users\vincentszeto\AppData\Roaming\Microsoft\Signatures\PWR_files\image001.png'/>" _
& sp & "<A href=""https://www.mrexcel.com/board""><img src= 'C:\Users\vincentszeto\AppData\Roaming\Microsoft\Signatures\PWR_files\image002.png'/></A>"
 
Upvote 0
Hi Vincent88,

try using environ("appdata") to get the information:
Code:
& sp & "<img src= '" & environ("appdata") & "\Microsoft\Signatures\PWR_files\image001.png'/>" _
& sp & "<A href=""https://www.mrexcel.com/board""><img src= '" & environ("appdata") & "\Microsoft\Signatures\PWR_files\image002.png'/></A>
Ciao,
Holger
 
Upvote 0
Hi HaHoBe,
What went wrong when I tried to adopt your suggestion to your string
 

Attachments

  • environ.png
    environ.png
    28.5 KB · Views: 11
Upvote 0
Hi Vincent,

you can only use Envirn with a Variable, so the upper part of the code should look like
Code:
...
  Dim strPic As String
  Dim strImg1 As String, strSh1 As String
  Dim strImg2 As String, strSh2 As String
  
  strImg1 = Environ("appdata") & "\Microsoft\Signatures\PWR_files\image001.png"
  strSh1 = "image001.png"
  strImg2 = Environ("appdata") & "\Microsoft\Signatures\PWR_files\image002.png"
  strSh2 = "image002.png"
...
Make sure that the constants are replaced throughout the code.

Ciao,
Holger
 
Upvote 0

Forum statistics

Threads
1,223,214
Messages
6,170,772
Members
452,353
Latest member
strainu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top