Issues embedding multiple images in Outlook email body

kripper

Board Regular
Joined
Dec 16, 2013
Messages
102
Good Afternoon,

Looking for some assistance on fixing an issue I can't seem to get past.

I have created code that will permit me to copy a userform image and paste it into an email body.

As the userform has a multipage with various tabs, I have modified the script to permit cycling thru each tab and taking another image capture of the userform with that tab data.

The issue I am having is when using a For Next loop, I can add the various images into the email as attachments, however I am struggling with making the code actually cycle thru embedding them as html images unless I specifically identify the image title, which defeats the purpose, as I wish to use the script on various userforms, and not all have the same number of tabs in their respective multipages.

Hoping that makes sense, code below, as well as some images that I am hoping will help.

The .HTML code is the area I am struggling with, as I have to specifically identify the image names in order for them to appear inline in the HTML body.

The commented out code below is the original area I had attempted, however, I geta frame of only one image with an "image not available" message in the email.

VBA Code:
#If Win64 Then '64?
Private Declare PtrSafe Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
     ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
#Else
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, _
     ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As LongPtr)
#End If

Const VK_SNAPSHOT = 44
Const VK_LMENU = 164
Const KEYEVENTF_KEYUP = 2
Const KEYEVENTF_EXTENDEDKEY = 1

Private Sub CUF_Click()
    Dim WB1 As Workbook, WB2 As Workbook
    Dim olApp As Object, OutMail As Object
    Dim StrBody As String, dt As String, dt1 As String
    Dim x As Integer, y As Integer

    dt = VBA.Format(Now, "YYYY-MM-DD")
    dt1 = VBA.Format(Now, "H:MM")

    Set WB1 = ThisWorkbook
  
    On Error Resume Next

    Application.ScreenUpdating = True
  
    StrBody = "Thanks" & "<br>" & "K."
              
    Set olApp = CreateObject("Outlook.Application")
    Set OutMail = olApp.CreateItem(0)
  
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Visible = False
    End With

    On Error GoTo 0
  
    For x = 1 To Me.MultiPage1.Pages.Count
  
    DoEvents
    Application.ScreenUpdating = False
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY, 0
    keybd_event VK_SNAPSHOT, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    keybd_event VK_LMENU, 0, KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP, 0
    DoEvents
    Workbooks.Add
    Set WB2 = ActiveWorkbook
    Application.Wait Now + TimeValue("00:00:01")
    ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, _
    DisplayAsIcon:=False
    ActiveSheet.Range("A1").Select
    ActiveSheet.PageSetup.Orientation = xlLandscape
    ActiveSheet.Shapes.Range(Array("Picture 1")).Select
    Selection.COPY
    With WB2.ActiveSheet.ChartObjects.Add(Selection.Left, Selection.Top, Selection.Width, Selection.Height)
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\" & "DashboardFile(" & x & ").jpg", "JPG"
    End With
  
    Application.Wait (Now() + TimeValue("00:00:03"))
  
    ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).DELETE

    WB2.Close False
  
    WB1.Activate
  
    Dim iNextPage As Long
    With Me.MultiPage1
        iNextPage = .Value + 1
        If iNextPage < .Pages.Count Then
            .Pages(iNextPage).Visible = True
            .Value = iNextPage
        End If
    End With
      
    Next x
  
    TempFilePath = Environ$("temp") & "\"
  
    With OutMail
        .ReadReceiptRequested = False
        .To = Me.SUM8.Text
        .CC = WB1.Worksheets("SETUP").Range("C9").Value
        .Subject = WB1.Worksheets("SETUP").Range("C4").Value & " - " & "PERFORMANCE DETAILS" & " - " & dt
       
       'CURRENT CODE - MUST IDENTIFY EACH IMAGE NAME SEPERATELY, WILL NOT ADD AS PART OF THE For Next LOOP.
       .HTMLBody = "<center>" & "<img src='cid:DashboardFile(1).jpg'" & "width='1600' height='1000'><br><img src='cid:DashboardFile(2).jpg'" & "width='1600' height='1000'><br><img src='cid:DashboardFile(3).jpg'" & "width='1600' height='1000'><br><img src='cid:DashboardFile(4).jpg'" & "width='1600' height='1000'><br><img src='cid:DashboardFile(5).jpg'" & "width='1600' height='1000'></center><br><left>" & StrBody & "</body>" & "</left>"

        'ORIGINAL CODE - NO SUCCESS
        'For y = 1 To Me.MultiPage1.Pages.Count
        '.HTMLBody = "<center>" & "<img src='cid:DashboardFile('" & y & "').jpg'" & "width='1600' height='1000'><br></center><br><left>" & StrBody & "</body>" & "</left>"
        '.Attachments.Add TempFilePath & "DashboardFile(" & y & ").jpg", olByValue, 0
        'Next y

        For y = 1 To Me.MultiPage1.Pages.Count
        .Attachments.Add TempFilePath & "DashboardFile(" & y & ").jpg", olByValue, 0
        Next y
        .Recipients.ResolveAll
        .Display
    End With
  
    On Error GoTo 0

    Set OutMail = Nothing
    Set olApp = Nothing
  
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .DisplayAlerts = True
        .Visible = True
    End With
End Sub
DashboardFile(1).jpg

DashboardFile(2).jpg
 

Attachments

  • DashboardFile(3).jpg
    DashboardFile(3).jpg
    26.3 KB · Views: 6
Last edited:

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Hi

I think I almost understand, but can I please just clarify:
  1. when you say the problem with embedding the images is that you need to know the image title. Here, are you referring to the filename; namely DashboardFile(X).jpg?
  2. you write in the comments that you "must identify each image name separately, will not add as part of the for next loop "- why won't it add the filename as part of the for next loop? Isn't that what your original code basically does, but using the y variable? I read the explanation starting with "which defeats the purpose ...", but I don't understand where the problem lies. Is it that you are taking pictures of the same numbered tabs (eg. "Tab 1") from two or three userforms, and that the filenames will conflict? Why do you even need to know the filenames at all? Couldn't you just save them with random filenames as you take each picture, store those filenames in an array, and then retrieve those names from an array when you go to embed them?
  3. In terms of embedding the pictures, I'm curious why you are editing the HTML code of the email, rather than using the .InlineShapes.AddPIcture method? I hate having to deal with the HTML code in outlook emails, and so avoid it as much as possible.
My apologies if I've missed something.
 
Upvote 0
Sorry - on rereading my point two, I appreciate it looks a whole lot like a rant, but I was just typing whatever came into my head.

The key point is - I don't think I understand the problem. Or, if I am understanding the problem correctly, I don't see why you can't solve it by storing filenames in an array...
 
Upvote 0

Forum statistics

Threads
1,223,227
Messages
6,170,849
Members
452,361
Latest member
d3ad3y3

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