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.
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
Attachments
Last edited: