Insert picture file, using variable, into text in .HTMLBody - html

I'm trying to use a variable to insert an image in an e-mail.
With OutlookItm
.To = strTo
.CC = strCc
.Subject = strSubject
.HTMLBody = "Hello all, <p>In attach the <b>Filtered Trunk Report</b> and below the <b>Invoice Volume chart</b>:</p>" & _
"<center><img src = Filename:ChartFile1 ></center>" & "<p>.</p>" & _
"<center><img src = 'C:\Users\matuo\OneDrive\Desktop\Chart2.jpg'></center>" & Signature
.Display
End With
The code works for "Chart2.jpg", but I want to use a variable for the directory and file.
The picture using the variable doesn't work.

Let's image you have got a string object pathToImage which contains the image path, in that case the code may look like:
With OutlookItm
.To = strTo
.CC = strCc
.Subject = strSubject
.HTMLBody = "Hello all, <p>In attach the <b>Filtered Trunk Report</b> and below the <b>Invoice Volume chart</b>:</p>" & _
"<center><img src = " & pathToImage & " ></center>" & "<p>.</p>" & _
"<center><img src = 'C:\Users\matuo\OneDrive\Desktop\Chart2.jpg'></center>" & Signature
.Display
End With
However, a local path to image is not really a good idea. Such images will not be displayed on the recipient side because the image itself is stored on your machine. Most probably you'd need to embed an image to the email itself. To get that done you need to attach the image file and set several properties - they are actually optional, even the following code works fine:
.Attachments.Add "C:\Users\JoeSchmo\Pictures\imageName.jpg", olByValue, 0
.HTMLBody = "<BODY><IMG src=""cid:imageName.jpg"" width=200> </BODY>"
But ideally you'd need to set the PR_ATTACH_CONTENT_ID and PR_ATTACHMENT_HIDDEN properties. For example:
Function SendasAttachment(fName As String)
Dim olApp As Outlook.Application
Dim olMsg As Outlook.MailItem
Dim olAtt As Outlook.Attachments
Set olApp = Outlook.Application
Set olMsg = olApp.CreateItem(0) ' email
Set olAtt = olMsg.Attachments
Const PR_ATTACH_MIME_TAG = "http://schemas.microsoft.com/mapi/proptag/0x370E001E"
Const PR_ATTACH_CONTENT_ID = "http://schemas.microsoft.com/mapi/proptag/0x3712001E"
Const PR_ATTACHMENT_HIDDEN = "http://schemas.microsoft.com/mapi/proptag/0x7FFE000B"
' attach file
olAtt.Add (fldName & fName)
Set l_Attach = olAtt.Add(fldName & fName)
Set oPA = l_Attach.PropertyAccessor
oPA.SetProperty PR_ATTACH_MIME_TAG, "image/jpeg"
oPA.SetProperty PR_ATTACH_CONTENT_ID, "myident"
oPA.SetProperty PR_ATTACHMENT_HIDDEN, True
olMsg.PropertyAccessor.SetProperty "http://schemas.microsoft.com/mapi/id/{00062008-0000-0000-C000-000000000046}/8514000B", True
olMsg.To = "test#email.com"
msgHTMLBody = "<HTML>" & _
"<head>" & _
"</head>" & _
"<BODY>" & "Hi " & olMsg.To & ", <br /><br /> I have attached " & fName & " as you requested." & _
"<br /><img align=baseline border=1 hspace=0 src=cid:myident width='400'/>" & _
"</BODY></HTML>"
' send message
With olMsg
.Subject = "Here's that file you wanted"
.BodyFormat = olFormatHTML
.HTMLBody = msgHTMLBody
.Save
'.Display
.Send
End With
End Function
Read more about that in the Embed Images in New Messages using a Macro article.

Related

VBA: Embedding a PNG in an Outlook Email - working for self not displaying for others [duplicate]

This question already has answers here:
Embed picture in outlook mail body excel vba
(2 answers)
Closed 1 year ago.
The below code with .PNG file referenced, works for me. However, while the .PNG gets inserted in the email, it's not actually embedded. As a result, when the recipient receives the email, the image is not displayed.
Sub Mail_workbook_Outlook_1()
relativepath1 = ThisWorkbook.Path & Application.PathSeparator & "Signature99" & ".png"
'Create a new email message
Set OutlookMessage = OutlookApp.CreateItem(0)
On Error Resume Next
With OutlookMessage
.To = Prime_Email
.cc = cc1
.BCC = ""
.Subject = "Volume - " & " " & str2 & "(" & Subject & ")"
.HTMLBody = RangetoHTML(Range("E2:N16")) & "<img src ='" & relativepath1 & "'>"
.send
'.Display
End With
On Error GoTo 0
Set OutlookMessage = Nothing
Set OutlookApp = Nothing
End Sub
First attach the image to your email, and then embed it within your email...
Sub Mail_workbook_Outlook_1()
Dim relativepath1 As String
relativepath1 = ThisWorkbook.Path & Application.PathSeparator
Dim filename As String
filename = "Signature99.png"
'Create a new email message
Set OutlookMessage = OutlookApp.CreateItem(0)
On Error Resume Next
With OutlookMessage
.To = Prime_Email
.CC = cc1
.BCC = ""
.Subject = "Volume - " & " " & str2 & "(" & Subject & ")"
.Attachments.Add relativepath1 & filename
.HTMLBody = RangetoHTML(Range("E2:N16")) & "<img src ='cid:" & filename & "'>"
.Send
'.Display
End With
On Error GoTo 0
Set OutlookMessage = Nothing
Set OutlookApp = Nothing
End Sub

Changing font size of the signature of an outlook email generated through VBA

i'm able to make the signature bold but i cant change the size. I can also change the size of the body but not the signature. I need to change the font size of the signature to match the font size of the body in the email.
Sub Email_Test()
'Exit function if user input incomplete:
If IsNull(Forms!frmCompMain!cboPayPrd) = True Then
MsgBox "Please provide the Pay Period parameter!", vbCritical
Exit Sub
End If
'-----------------------------------------
----'DECLARE AND SET VARIABLES
Dim myOutlok As Object
Dim myMailItm As Object
Dim Signature As String
Dim OtlApp As Object
Dim OtlNewMail As Object
Dim olMailItem As Object
Dim PayPrd As String
Set OtlApp = CreateObject("Outlook.Application")
Set OtlNewMail = OtlApp.CreateItem(0)
PayPrd = Forms!frmCompMain!cboPayPrd
'-----------------------------------------
-----'GET DEFAULT EMAIL SIGNATURE
Signature = Environ("appdata") & "\Microsoft\Signatures\"
If Dir(Signature, vbDirectory) <> vbNullString Then
Signature = Signature & Dir$(Signature & "*.htm")
Else:
Signature = ""
End If
Signature =
CreateObject("Scripting.FileSystemObject").GetFile(Signature).OpenAsTextStream(1, -2).ReadAll
'-----------------------------------------
----'CREATE EMAIL
OtlNewMail.HTMLBody = Signature
With OtlNewMail
.to = ""
.CC = ""
.Subject = ""
.HTMLBody = "<font size='2'> Hello," & "<br />" & _
"<br />" & _
"" & "<br />" & _
"<br />" & _
"<b>Production Period:</b> " & DateSerial(Year(PayPrd)" & _
"<br />" & _
"<b> Pay Date:</b> " & DateSerial(Year(PayPrd), Month(PayPrd) + 1, 10) &
"<br />" & _
"<br />" & _
"Please let me know if you have any questions." & "<br />" & _
"<br />" & _
"<b>" & Signature & "</b>"
.display
'.Send
End With
'-----------------------------------------
----'CLEANUP
End Sub
Firstly, you cannot concatenate two HTML strings and expect a valid HTML string back. The two must be merged.
Secondly, if the font size is explicitly set in the HTML signature, your code explicitly wrapping the signature in an element with a specified font size would do nothing. You'd need to use the HTMLDocument interface or the Word object model to set the size.
Or, the simplest possible solution, make sure the stationary signature already has the right font.
You should use the following code replace the .HTMLBody content:
Signature = "<b style='color:red;'>Your Sigature</b>"
With OutMail
.To = ""
.Subject = "This is the Subject line"
.HTMLBody = "<font style='font-size:20px !important;'> Hello <br /><br/><br/><b>Production Period:</b> DateSerial(Year(PayPrd)<br /><b> Pay Date:</b> DateSerial(Year(PayPrd), Month(PayPrd) + 1, 10)<br/><br/>Please let me know if you have any questions.<br/><br/><b style='font-size 14px !important'>" & Signature & "</b></font>"
.Display
If the font size is set in the HTML signature, You'd need to use the HTMLDocument interface to set the size.

Outlook VBA variable into HTML Body

I created an Macro in MS Outlook for an email. The user inputs an answer to a question which results in a variable storing that data as a string. An email is then generated in HTML with a hyperlink containing that variable. I can't seem to figure out how to concatenate the variable "strTrackingNumber" into the complete hyperlink. Any suggestions?
Option Explicit
Sub TestFile
Dim strTrackingNumber as String
strTrackingNumber = InputBox("Please input the Tracking Number")
Set objMsg = Application.CreateItem(olMailItem)
With objMsg
.To = "mickey.smith#surfer.com"
.CC = ""
.BCC = ""
.Subject = "Forecast"
.Categories = ""
.BodyFormat = olFormatHTML ' send HTML message
.HTMLBody = "<style> body{color:black;font-family:Arial;font-size: 12pt;}" & _
"<HTML><body>Dear Member,<br><br> The following document is ready for your review."<a href= 'http://www.bluewave.com/' & strTrackingNumber>Tracking & strTrackingNumber.</a></body>
.Display
End With
Set objMsg = Nothing
End Sub
Output link should look like this: http://www.bluewave.com/Tracking Number
e.g. http://www.bluewave.com/RA-15-30922
.HTMLBody = "<style> body{color:black;font-family:Arial;font-size: 12pt;} </style>" & _
"<HTML><body>Dear Member,<br><br> " & _
"The following document is ready for your review. " & _
"<a href= 'http://www.bluewave.com/" & strTrackingNumber & "'>Tracking " & _
strTrackingNumber & ".</a></body>"

Access VBA: Why doesn't my image embed into the HTML email?

I am using Microsoft Access to send out emails and am trying to insert an image into the email so that there is a signature.
I am aware that for a recipient to see the image they must have access to it, so because the image is on my local hard drive I am trying to embed it into the body of the email.
I have followed the link: How to add an embedded image to an HTML message in Outlook 2010
To have the following code:
Dim MyOutlook As Object
Dim MyMessage As Object
Set MyOutlook = CreateObject("Outlook.Application")
Set MyMessage = MyOutlook.CreateItem(0)
Dim colAttach As Outlook.Attachments
Dim oAttach As Outlook.Attachment
Set colAttach = MyMessage.Attachments
Set oAttach = colAttach.Add("C:\user1\Documents\signature.jpg")
With MyMessage
Dim Greeting As String
If Time >= #12:00:00 PM# Then
Greeting = "Afternoon,"
Else
Greeting = "Morning,"
End If
.To = strTo
.Subject = strSubject
.HTMLBody = "<font face=Arial><p>" & "Good " + Greeting + "</p>"
.HTMLBody = .HTMLBody + "<p>" & "Please find attached your latest document." & "</p>"
.HTMLBody = .HTMLBody + "<p>" & "If you have any questions...." & "</p>"
.HTMLBody = .HTMLBody + "<p>" & "Kind Regards" & "</p>"
.HTMLBody = .HTMLBody + "<p>" & "..." & "</p></font>"
.HTMLBody = .HTMLBody + "<IMG alt='' hspace=0 src='cid:signature.jpg' align=baseline border=0>"
strAttachments = "2"
If strAttachments <> "" Then
For i = 0 To intNrAttch - 1
.Attachments.Add strFiles(i), 1, intPos
Next i
End If
.Send
End With
But for some reason, what happens it'll attach the image to the email but not display it:
Can someone please help?
It might be worth noting, that I can have pretty much the same code to send out an email with an image from Excel that work's, so I think there's something with Access that is preventing the code from working.
I had a similar problem. My "fix" was to include a .Display before the .Send.

Add image from Excel sheet to Outlook HTML body using Excel VBA

I am trying to add an image from an Excel sheet to an Outlook email.
I tried using a link to an image stored in a network location and on the Internet. However, not all users will have access to these locations.
Is it possible to store the image in another worksheet and then copy it into the email body?
I know the below won't work because you can't export shapes but can I do something like this?
ActiveUser = Environ$("UserName")
TempFilePath = "C:\Users\" & ActiveUser & "\Desktop\"
Sheets("Images").Shapes("PanelComparison").Export TempFilePath & "\PanelComparison.png"
panelimage = "<img src = ""TempFilePath\PanelComparison.png"" width=1000 height=720 border=0>"
The CreateEmail Sub calls the SaveToImage Sub. The SaveToImage sub grabs a range, creates a chart on a new page and then saves the picture(objChart) to a specified directory.
The LMpic string variable calls the image just saved and inputs it into the HTML body.
Public Sub CreateEmail()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim FN, LN, EmBody, EmBody1, EmBody2, EmBody3 As String
Dim wb As Workbook
Dim ws As Worksheet
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set wb = ActiveWorkbook
Set ws = Worksheets("Sheet1")
Call SaveToImage
ws.Activate
LMpic = wb.Path & "\ClarityEmailPic.jpg'"
On Error GoTo cleanup
For Each cell In Columns("D").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*#?*.?*" Then
FN = Cells(cell.Row, "B").Value
LN = Cells(cell.Row, "A").Value
EmBody = Range("Email_Body").Value
EmBody1 = Range("Email_Body1").Value
EmBody2 = Range("Email_Body2").Value
'EmBody3 = Range("Email_Body3").Value
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Volt Clarity Reminder "
.Importance = olImportanceHigh
.HTMLBody = "<html><br><br><br>" & _
"<table border width=300 align=center>" & _
"<tr bgcolor=#FFFFFF>" & _
"<td align=right>" & _
"<img src='" & objRange & "'>" & _
"</td>" & _
"</tr>" & _
"<tr border=0.5 height=7 bgcolor=#102561><td colspan=2></td></tr>" & _
"<tr>" & _
"<td colspan=2 bgcolor=#E6E6E6>" & _
"<body style=font-family:Arial style=backgroung-color:#FFFFFF align=center>" & _
"<p> Dear " & FN & " " & LN & "," & "</p>" & _
"<p>" & EmBody & "</p>" & _
"<p>" & EmBody2 & "<i><font color=red>" & EmBody1 & "</i></font>" & "</p>" & _
"</body></td></tr></table></html>"
.Display 'Or use Display
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
Public Sub SaveToImage()
'
' SaveToImage Macro
'
Dim DataObj As Shape
Dim objChart As Chart
Dim folderpath As String
Dim picname As String
Dim ws As Worksheet
Application.ScreenUpdating = False
Set ws = Worksheets("Sheet2")
folderpath = Application.ActiveWorkbook.Path & Application.PathSeparator 'locating & assigning current folder path
picname = "ClarityEmailPic.jpg" 'image file name
Application.ScreenUpdating = False
Call ws.Range("Picture").CopyPicture(xlScreen, xlPicture) 'copying the range as an image
Worksheets.Add(after:=Worksheets(1)).Name = "Sheet4" 'creating a new sheet to insert the chart
ActiveSheet.Shapes.AddChart.Select
Set objChart = ActiveChart
ActiveSheet.Shapes.Item(1).Width = ws.Range("Picture").Width 'making chart size match image range size
ActiveSheet.Shapes.Item(1).Height = ws.Range("Picture").Height
objChart.Paste 'pasting the range to the chart
objChart.Export (folderpath & picname) 'creating an image file with the activechart
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete 'deleting sheet4
Application.DisplayAlerts = True
End Sub
In general email images are stored on a web server, with the SRC pointing to that server (http://...). They're not embedded in the email itself.