Outlook VBA variable into HTML Body - html

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>"

Related

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

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.

HTML hyperlink stops at spaces in filepath

When sending an email via a VBA code I have written, the filepath being sent in the body of the email stops at the first space. I believe I have the right amount of quotations around it, but its still coming up short.
Also, is anyone aware of a quick fix so that it includes the signature of the user sending the email?
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo Cleanup
For Each cell In Columns("M").Cells.SpecialCells(xlCellTypeConstants)
If LCase(Cells(cell.Row, "M").Value) = "no" Then
Set OutMail = OutApp.CreateItem(0)
strbody = "Dear " & Cells(cell.Row, "A").Value _
& "<br>" & "<br>" & _
"You still have outstanding work on the Rescan Spreadsheet " & _
" Title number: " & Cells(cell.Row, "E").Value _
& "<br>" & "<br>" _
& "Click here to open file location"
On Error Resume Next
With OutMail
.To = Cells(cell.Row, "B").Value
.CC = "Bethany.Turner#Landregistry.Gov.uk"
.Subject = "Re-Scan Reminder"
.HTMLbody = strbody
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
Cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
MsgBox "Reminder Sent", vbOKOnly
End Sub
Following the display of the message, when you click the hyperlink, it stops and provides an error message saying \\cv-vfl-d01\dlr_office\Operational cannot be located.
You don't need to use ampersands between the href= and the file name, but you do need to add an extra double-quote:
"<A href=""\\cv-vfl-d01\dlr_office\Operational Teams\RR Scanning Team\" & _
"Back file QA Xerox\Document Rescans\Rescans 2019"">Click here to open file location</A>"
HTML requires the url to have quotation marks around the link. If this was a normal string in HTML it would look like:
My link name
Alternatively, you can use the Chr() function to place the double-quote character in your string if it helps you:
"<A href=" & Chr$(34) & "\\cv-vfl-d01\dlr_office\...

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.

VBA & HTMLBody - Spacing between Body and Signature

I will be using excel to send emails to my clients requesting certain files from them. I have everything working except for 1 small detail and I do not want to use this until I have that 1 detail figured out.
My email populates almost perfectly, except for the fact that at the end, there is about 3 lines of space between "Regards" and my signature. I'm not sure why this is happening. It shows up like this:
Thank you for your attention in this matter.
Regards,
Signature
Does anyone know how to fix it. My code is listed below:
Sub KYC_FATCA()
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim signature As String
Dim AccOpen As String
Dim ConDoc As String
Dim SIP As String
Dim AFS As String
Dim W8 As String
Dim LEI As String
Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
On Error GoTo cleanup
For Each cell In Columns("G").Cells.SpecialCells(xlCellTypeConstants)
'KYC Account Opening Form
If (Cells(cell.Row, "I").Value) = "No" Then
AccOpen = "<b>KYC Account Opening Form</b> ." & "<br>" & "<br>"
Else
AccOpen = ""
End If
'Constating Document
If (Cells(cell.Row, "J").Value) = "No" Then
ConDoc = "<b>Constating Document</b> - ." & "<br>" & "<br>"
Else
ConDoc = ""
End If
'Statement of Policy and Guidelines (SIP&G)
If (Cells(cell.Row, "L").Value) = "No" Then
SIP = "<b>Statement of Policy and Guidelines (SIP&G)</b> - " & "<br>" & "<br>"
Else
SIP = ""
End If
'Audited Financial Statements (AFS)
If (Cells(cell.Row, "M").Value) = "No" Then
AFS = "<b>Audited Financial Statements (AFS)</b> - ." & "<br>" & "<br>"
Else
AFS = ""
End If
'W-8BEN-E Form
If (Cells(cell.Row, "N").Value) = "No" Then
W8 = "<b>W-8BEN-E Form</b> - " & "<br>" & "<br>"
Else
W8 = ""
End If
'Legal Entity Identifier (LEI)
If (Cells(cell.Row, "O").Value) = "Needed" Then
LEI = "<b>Legal Entity Identifier (LEI)</b> - " & "<br>" & "<br>"
Else
LEI = ""
End If
If cell.Value Like "?*#?*.?*" And _
(Cells(cell.Row, "H").Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)
With OutMail
.Display
End With
signature = OutMail.HTMLbody
On Error Resume Next
With OutMail
.To = cell.Text 'Whatever is in cell G
.cc = Cells(cell.Row, "C").Value
'Testing if statements - The below one works perfect
'If LCase(Cells(cell.Row, "Z").Value) = "" Then
' .cc = Cells(cell.Row, "P").Value
'End If
.Subject = Cells(cell.Row, "A").Value & " - " & "Documentation Request" _
.HTMLbody = "<p style='font-family:calibri;font-size:11pt'>" & "Dear " & Cells(cell.Row, "D").Value & ",<br>" & "<br>" & _
"On behalf of " & Cells(cell.Row, "B").Value & ", please by " & "<b><u>" & Cells(cell.Row, "Q").Text & "</b></u>" & "." & "<br>" & "<br>" & _
AccOpen & _
ConDoc & _
SIP & _
AFS & _
W8 & _
LEI & _
"If you have any questions and/or concerns, please contract your Relationship Manager, " & Cells(cell.Row, "B").Value & "." & "<br>" & "<br>" & _
"Thank you for your attention in this matter." & "<br>" & "<br>" & _
"Regards," & "</p>" & _
signature _
'You can add files also like this
If (Cells(cell.Row, "I").Value) = "No" Then
.Attachments.Add ("C:doc")
End If
.Display 'This will open the message itself. If you'd like to send right away, use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
The problem is this line:
signature = OutMail.HTMLbody
This is a clever way to get the signature, but the default email body has a couple blank lines above the signature, and those are getting included when you concatenate the email.
I would visually check signature in a debugger and see what is in there, and remove the stuff you don't want. A simple example might be:
Function RemoveBlankStuff(ByVal text as string) as string
text = text.Replace("<P></P>","") 'Remove any empty paragraphs
text = text.Replace("<BR>","") 'Remove any line breaks
Return text;
End Function
signature = RemoveBlankStuff(OutMail.HTMLBody);
You will need to modify the above function depending on what you find in signature.
I was doing something similar and running into the same issue.
This should work if you replace this portion of code:
With OutMail
.Display
End With
signature = OutMail.HTMLbody
With the following code - it effectively opens, deletes whitespace, and deletes/discards the e-mail created to get the signature:
'gets default signature from e-mail
With OutMail
'2 = HTMLBody
.BodyFormat = 2
.Display
'deletes blank space present before signature
signature = Replace(OutMail.HTMLBody, "<p class=MsoNormal><o:p> </o:p></p>", "")
'removes entire e-mail contents and then closes with discard
OutMail.HTMLBody = Replace(OutMail.HTMLBody, OutMail.HTMLBody, "")
OutMail.Close 1
End With
Not sure if it makes a difference, but in .HTMLBody, I also start as -
.HTMLBody = .HTMLBody & "Good Afternoon," & "<br>" & "whateveryourtextis" & "Thanks," & "<br><br>" & signature

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.