Have been searching for hours and can't find anything to answer this...
I have a worksheet that users will insert pictures (jpeg, gif etc.) as visual aids.
What I would like is a way to extract all of the object images present on the worksheet and insert them as attachments in an Outlook email. I already have an email Sub...just can't figure out how to get the pictures into it. My routine is below:
I have a worksheet that users will insert pictures (jpeg, gif etc.) as visual aids.
What I would like is a way to extract all of the object images present on the worksheet and insert them as attachments in an Outlook email. I already have an email Sub...just can't figure out how to get the pictures into it. My routine is below:
Code:
Sub SendWorkBook()
Dim outlookApp As Object
Dim OutlookMail As Object
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim Rng As Range
Set outlookApp = CreateObject("Outlook.Application")
Set OutlookMail = outlookApp.CreateItem(0)
Set Rng = [PrtArea]
Set wb1 = ActiveWorkbook
On Error Resume Next
OpenOutlook
TempFilePath = VBA.Environ$("temp") & "\"
TempFileName = "Customer Complaint - " & ReplaceIllegalChar([LogNum]) & " - " & ReplaceIllegalChar([Complaint]) & " " & Format(Now, "mmddyy hhmm")
FileExtStr = ".xlsm"
Filename = TempFilePath & TempFileName & FileExtStr
wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)
With OutlookMail
.To = [EmailTo].Value
.CC = [EmailCC].Value
.BCC = ""
.Subject = "New Customer Complaint - " & [LogNum] & " - " & [Complaint]
.HTMLBody = RangetoHTML(Rng)
.Attachments.Add wb2.FullName
.Display
End With
wb2.Close SaveChanges:=False
' Delete the file.
Kill TempFilePath & TempFileName & FileExtStr
Set OutlookMail = Nothing
Set outlookApp = Nothing
End Sub