PDA

View Full Version : Embedded HTML Image Issues



evan.shaw88
05-27-2016, 06:06 AM
Hello,

I am having trouble getting the image to display in the html body and have run out things to try via other online forum questions. This code is picking templates created in another macro and sending them out to their respective cost center manager. The signature is viewable but the embedded picture is not coming through. I would grately appreciate suggestions.

16276

Sub TemplatesInsideFolder()

Dim wb As Workbook
Dim Path As String
Dim File As String
Dim Extension As String
Dim SelectFolder As FileDialog
Dim OutApp As Object
Dim OutMail As Object
Dim SigString As String
Dim Signature As String
Dim fso As Object
Dim ts As Object
Dim logo As String

'Optimization
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

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

'This is link to the e-mail body:
SigString = "\\us-filesp02\Teams2\FIXEDASSETS\03 Retirements_Transfers\PhysicalInventory\2016Physical.htm"

If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If

On Error Resume Next

'Select Folder
Set SelectFolder = Application.FileDialog(msoFileDialogFolderPicker)

With SelectFolder
.Title = "Please, select folder with templates."
.AllowMultiSelect = False
If .Show <> -1 Then GoTo NextCode
Path = .SelectedItems(1) & "\"
End With

'If hit Cancel
NextCode:
Path = Path
If Path = "" Then GoTo GetDefault

Extension = "*.xlsm"

File = Dir(Path & Extension)

'Loop
Do While File <> ""
'Set wb = Workbook opened
Set wb = Workbooks.Open(Filename:=Path & File)

'New email
Set OutMail = OutApp.CreateItem(olMailItem)

With OutMail
SendUsingAccount = OutApp.Session.Accounts.Item(2)
.To = wb.Sheets("Template").Range("C6").Value
.CC = ""
.BCC = ""
.Subject = "2016 Physical Asset Inventory"
.HTMLBody = "<img src=cid:'\\us-filesp02\Teams2\FIXEDASSETS\03 Retirements_Transfers\PhysicalInventory\HiltiLogo.png'>" & Signature
.Attachments.Add ActiveWorkbook.FullName
.Display 'or use .Send

End With

On Error GoTo 0

'Save/close Workbook
wb.Close SaveChanges:=True

'Next
File = Dir

Loop

'Back to Default Settings
GetDefault:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function