My data is set up like this:
-On Excel, I have a worksheet, "Test1", which has a list of people I want to send emails to. Like such;
No. Version Company Name Email
1 R x Max max#abc.com
2 E y Bill bill#abc.com
3 C z Scott scott#abc.com
The emails I want to send differ slightly by type. My current code is as follows:
Sub mailTest()
Dim olApp As Outlook.Application
Dim olMail As Outlook.MailItem
For i = 2 To 3
Set olApp = New Outlook.Application
Set olMail = olApp.CreateItem(olMailItem)
mailBody = Worksheets("BODY").Cells(1, 1).Value & Worksheets("Test1").Cells(i, 4) _
& Worksheets("BODY").Cells(2, 1).Value
With olMail
.To = Worksheets("Test1").Cells(i, 5).Value
.Subject = Worksheets("Test1").Cells(i, 3).Value
.HTMLBody = mailBody
.Display
End With
Set olMail = Nothing
Set olApp = Nothing
Next
End Sub
The code above displays the emails as the main body is in Cell A2 of sheet "BODY". The "Hello" is stored in Cell A1, and also displays fine as I have HTML coding in both these cells to set the font to Calibri and the size to 3.
The issue is when I'm pulling the names of people from sheet Test1 in Column 4 using the code;
& Worksheets("Test1").Cells(i, 4)
It is displaying with a different font, defaulting to Times New Roman. What I'm left with is everything displaying in Calibri, with just their names being pulled in Times New Roman.
Is there any way to fix this without adding HTML code in each of the name cells? The actual file I'm working on has about 500 names so manually doing it would be a pain...
Thanks everyone.
Try replace
.HTMLBody = mailBody
with
.HTMLBody = "<!DOCTYPE html><html><head><style>"
.HTMLBody = .HTMLBody & "body{font-family: Calibri, ""Times New Roman"", sans-serif}"
.HTMLBody = .HTMLBody & "</style></head><body>"
.HTMLBody = .HTMLBody & mailBody & "</body></html>
Related
I created a vba code but the font and the size of the mail are incorrect. I would like Calibri 11 but it's Calibri 10 for the first line (Hello) and Verdana 10 for the rest. How to proceed?
Sub mail_outlook()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.SentOnBehalfOfName = "xxxxxxxxxxxx"
.Display
.To = "xxxxxxxxxxxxxxxxxx"
.HTMLBody = "Hello, " & "<br>" & "<br>" & "Please find in attachment the Report." & "<br>" & "We remain available should you have any questions." & .HTMLBody
.CC = "xxxxxxxxxxxxxxx"
.BCC = ""
.Subject = "Report"
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
You can specify the font size in the HTML:
"<font style=""font-family: Calibri; font-size: 11pt;""> your content goes here</font>"
See Change HTML email body font type and size in VBA for more information.
Also you may use the Word object model for doing that programmatically. The WordEditor of the Inspector class returns an instance of the Document class from the Word object model which represents the message body. See Chapter 17: Working with Item Bodies for more information. For example, in Word you could use the following sequence of property calls:
Selection.WholeStory
Selection.Font.Size = 12
Selection.Font.Name = "Georgia"
I am trying to sent an email from outlook using Excel Macro and I need a solution on how I can move the tables I copy paste from the Excel to Outlook body, which will always get aligned to left side, and I want it to be moved to little right so that I will get a perfectly fit/alignment with the other contents I have on the top.
My Code
Sub Table_CopyPaste()
Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object
Set outlook = CreateObject("Outlook.Application") Set newEmail = outlook.CreateItem(0)
StrBody1 = "<o:p> </o:p><p class=MsoNormal><span lang=EN-US style='color:#1F497D'><span style='font:11.0pt 'Calibri'>Hello,</Span></p><p class=MsoNormal><span style='font:11.0pt 'Calibri(Body)'>Attached you can find a file with all your Status for month 10_2019. </p></span><p class=MsoNormal><span style='font:11.0pt 'Calibri(Body)'>Below you can find an overview of your current status and your unit status.</span></span></p>" _
& "<p class=MsoListParagraph style='margin-left:53.4pt;text-indent:-18.0pt;mso-list:l0 level1 lfo2'><span style='font:11.0pt 'Calibri'><span lang=EN-US style='color:#1F497D'>1) We have extended the report with additional information, so you can develop a more complete view on your status:" _
& "<br>" _
& "<br> -   HR" _
& "<br> -   Accounts" _
& "<br> -   Finance" _
With newEmail
.To = "Test#mail.com"
.CC = ""
.BCC = ""
.Subject = "Data"
.HTMLBody = StrBody1
.Display
Set xInspect = newEmail.GetInspector
Set pageEditor = xInspect.WordEditor
Sheets("Statistics_Sheet").Range("A3:D6").Copy
pageEditor.Application.Selection.Start = Len(.HTMLBody)
pageEditor.Application.Selection.End = pageEditor.Application.Selection.Start
pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)
.Display
'.Send
Set pageEditor = Nothing
Set xInspect = Nothing End With
Set newEmail = Nothing Set outlook = Nothing
End Sub
This is the first time I am working on integrating outlook with macro, so no much idea how to solve this. The code is working fine once we run this code I need the table to be placed aligned with the bullet point 'Finance'
After too many search here and there, I find that its not possible to move it but a workaround here is to add some extra blank cells in that range so that when it copy pasted to outlook you will get it aligned to the text (Adjust the width of the cells to change the alignment)
But I find a code which work like a charm,
Sub PublishTable()
Dim WB As ThisWorkbook, P As String, WS As Worksheet, Rng As Range, New_WB As Workbook, RNG2 As Range, FolderPath As String
Set WB = ThisWorkbook
Set WS = WB.Sheets("Statistics_Sheet")
FolderPath = Application.ActiveWorkbook.Path
Set Rng = Sheets("Statistics_Sheet").Range("C3:F6")
P = FolderPath & "\Calculation_of_exception_status.html"
Workbooks.Add
Set New_WB = ActiveWorkbook
ThisWorkbook.Activate
Rng.Copy
New_WB.Activate
ActiveCell.PasteSpecial xlPasteValues
ActiveCell.PasteSpecial xlPasteFormats
ActiveCell.PasteSpecial xlPasteColumnWidths
ActiveCell.PasteSpecial xlPasteFormats
New_WB.PublishObjects.Add(xlSourceRange, P, New_WB.Sheets(1).Name, New_WB.Sheets(1).UsedRange.Address, xlHtmlStatic).Publish (True)
ActiveWorkbook.Close SaveChanges:=False
Dim fso As New FileSystemObject
Set fso = New Scripting.FileSystemObject
Dim Final_File As Scripting.TextStream
Set Final_File = fso.OpenTextFile(P, ForReading)
StrTable2 = Final_File.ReadAll
End Sub
And when you use Strtable2 in your outlook body use below code, adjust '20.3pt' according to your requirement.
olMailItm.HTMLBody = "<table class=MsoNormalTable border=0 cellspacing=0 cellpadding=0 style='margin-left:20.3pt;border-collapse:collapse'>" & StrTable2 & "</Table>"
If it's an actual HTML <table> element that it inserts, you can add a stylesheet to the .HTMLBody
At the top, Dim a variable:
Dim sStyles As String
sStyles = "<style> table {margin-left:150px;} table table {margin-left:0px;} </style><br>"
And then where you set the .HTMLBody, add it in like this:
.HTMLBody = sStyles & StrBody1
Then adjust the 150 number in the code to whatever you want to get it to align where you want it.
I have an access query which I aim to loop through and write the contents to the email body of an outlook email. The below code does the job, however if there are a lot of lines, it doesn't look great and becomes very busy, visually.
I'd like to either, add some formatting rules which will align each variable into a "column", or make each variable a fixed length so that the pipes ("|") align (and of course making the variable fixed length would probably mean filling some with " " spaces from the left.
Alternatively, I could try sort this issue out using HTML or something? though I have no experience with that, but if this is the way to go, any advise would be greatly appreciated.
Public Sub Test()
On Error GoTo Error_Handler
Dim strbody, DateStamp
strbody = ""
DateStamp = Format(Date, "Medium Date")
Dim MyDB As DAO.Database
Dim Tem As DAO.Recordset
Set MyDB = CurrentDb()
Set Tem = MyDB.OpenRecordset("TestQuery", dbOpenForwardOnly)
With Tem
Do While Not .EOF
strbody = strbody + (CStr(![Num]) + " | " + CStr(Format(![TDate], "Medium Date")) + " | " + CStr(Format(![VDate], "Medium Date")) + " | " + CStr(Format(![QTY], "Standard")) + " | " + ![Name] & vbNewLine)
.MoveNext
Loop
End With
Tem.Close
Set Tem = Nothing
Dim OutApp As Object
Dim OutMail As Object
Dim objOutlook As Outlook.Application
Dim objEmail As Outlook.MailItem
Set objOutlook = CreateObject("Outlook.application")
Set objEmail = objOutlook.CreateItem(olMailItem)
With objEmail
.To = "test#abc.com"
.subject = "Test" & " " & DateStamp
.Body = strbody
.Display
End With
Exit_Here:
Set objOutlook = Nothing
Exit Sub
Error_Handler:
MsgBox Err & ": " & Err.Description
Resume Exit_Here
End Sub
Currently, the output in the email looks a bit like this:
1234 | 22-Aug-18 | 23-Aug-18 | 1,000.00 | testname 123
5678 | 21-Aug-18 | 22-Aug-18 | 50,000.00 | second testname of different length
The more lines the messier it gets, in addition to missing column names.
Again, any help is greatly appreciated. Thank you.
I do this with HTML mails.
I have a HTML mail template saved as .oft file, and create the mail item like this:
Dim oItem As Outlook.MailItem
Set oItem = oOutlook.CreateItemFromTemplate(TemplatePath)
The mail template contains variables like $TableGoesHere$ which are replaced by the variable data when creating the mail, e.g.
Set Tem = MyDB.OpenRecordset("TestQuery", dbOpenForwardOnly)
strTbl = OutlookHtmlTableFromRS(Tem)
oItem.HtmlBody = Replace(oItem.HtmlBody, "$TableGoesHere$", strTbl)
with the function:
' Create HTML table from a recordset, with all columns except those in <sExcl>
' Returns HTML string to insert into HTML mail
Public Function OutlookHtmlTableFromRS(RS As Recordset, Optional sExcl As String = "") As String
Dim fld As DAO.Field
Dim S As String
' Table heading row
S = "<table cellpadding='5' style='text-align:left; border: 1px solid gray; border-collapse:collapse; font-family:Calibri, Helvetica, sans-serif; font-size:11pt;'>" & _
"<tr style='padding:5px;border: 1px solid gray;'>"
For Each fld In RS.Fields
If InStr(sExcl, fld.Name) = 0 Then
S = S & "<th style='border: 1px solid gray;'>" & fld.Name & "</th>"
End If
Next fld
S = S & "</tr>"
' Data rows
Do While Not RS.EOF
S = S & "<tr style='padding:5px;'>"
For Each fld In RS.Fields
If InStr(sExcl, fld.Name) = 0 Then
S = S & "<td style='border: 1px solid gray;'>" & fld.Value & "</td>"
End If
Next fld
S = S & "</tr>"
RS.MoveNext
Loop
S = S & "</table>"
RS.Close
OutlookHtmlTableFromRS = S
End Function
Yes, HTML is the best way! :) With HTML you can create tables in Outlook and have formatting too! And HTML is pretty easy. For any formatting you want, just google it. For example, if you wanted some of the data to be right aligned, you might google "html table right align". There are many helpful websites out there for HTML.
The below VBA code is what I used to put the contents of an Access query into the body of an Outlook email.
While it may look long, it works and it's the best way to copy a query or table into an email.
I love this! My email looks really good!
Private Sub btnEmail_Click()
'This will open an email in your Outlook and compose it for you. You review and click send.
'This macro requires the reference "Microsoft Outlook 16.0 Object Library" to be enabled.
Dim f As Long, c As Long
Dim sTable As String
Dim rs As DAO.Recordset
Dim olApp As Outlook.Application
Dim olMsg As Outlook.MailItem
Dim olRecip As Recipient
Dim Recipients As Recipients
Dim qField(1 To 4) 'array
''Table Header
qField(1) = "Group Number"
qField(2) = "Group Name"
qField(3) = "PTD"
qField(4) = "Term Date"
sTable = "<table border=0 cellspacing=0 style='padding:0in 5.5pt 0in 5.5pt'><tbody>"
sTable = sTable & "<tr bgcolor=""#70ad47""><font color=""white""><b><td>Group#</td>" 'white font, bold, green fill
sTable = sTable & "<td>Group Name</td>"
sTable = sTable & "<td>PTD</td>"
sTable = sTable & "<td>Term Date</td></b></font></tr>"
''Rows
Set rs = CurrentDb.OpenRecordset("TestQuery")
Do Until rs.EOF
c = c + 1 'counter for the every other row light green
If c Mod 2 = 0 Then 'every other row light green
sTable = sTable & "<tr style=""background: #e2efd9"">"
Else
sTable = sTable & "<tr>" 'open row
End If
For f = 1 To 4 'cells
sTable = sTable & "<td>" & rs.Fields(qField(f)) & "</td>"
Next
sTable = sTable & "</tr>" 'close row
rs.MoveNext
Loop
sTable = sTable & "</tbody></table>" 'close table
rs.Close
Set rs = Nothing
''Compose Email
Set olApp = CreateObject("Outlook.Application")
Set olMsg = olApp.CreateItem(olMailItem)
olMsg.To = "test#abc.com"
For Each olRecip In olMsg.Recipients
olRecip.Resolve
Next
olMsg.Subject = "Test " & Format(Date, "Medium Date")
olMsg.Display 'This must go before the .HTMLBody line b/c that is the only way to capture the existing default signature.
olMsg.HTMLBody = "<Body><div>Hello,<br>" & _
"Please see report below.<br><br>" & sTable & olMsg.HTMLBody
I am working with VBA through Access to create mail.
When I adjust an image size to less than the actual size, it embeds. When I omit size or put in as actual size, the image comes as an attachment.
Below is code snippet, miniplane.jpg comes as an attachment. Its actual size is 600x160. If I change in the code to 300x80 it shows.
Sub send_SHCmail()
'>>>> Declarations >>>>
Dim strPath As String
Dim strFileName As String
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
Dim olApp As Object
Dim objMail As Object
Set SHCData1 = Nothing
Set SHCData2 = Nothing
'>>>> Email Creation and Outlook Error Loop >>>>
On Error Resume Next 'Keep going if there is an error
Set olApp = GetObject(, "Outlook.Application") 'See if Outlook is open
If Err Then 'Outlook is not open
Set olApp = CreateObject("Outlook.Application") 'Create a new instance
End If
'Create e-mail item
Set objMail = olApp.CreateItem(olMailItem)
With objMail
'Set body format to HTML
.BodyFormat = olFormathtml
.To = "no-reply#email.com"
.Bcc = SHCDistribution
.Sentonbehalfofname = "test#email.com"
.Subject = "Planning Report - " & Format(Now, "MMMM d, yyyy")
.Attachments.Add "\\local\Sdata\Logo-Facet-01.png", olByValue, 0
.Attachments.Add "\\local\Sdata\miniplane.jpg", olByValue, 0
.HTMLBody = "<!DOCTYPE html>"
'Body Header
.HTMLBody = .HTMLBody & "<html><head><body>"
.HTMLBody = .HTMLBody & "<img src=""cid:Logo-Facet-01.png"" alt=""Image Missing"" width=""215.6"" height=""96.53"" style=""display: block;"" />"
.HTMLBody = .HTMLBody & "<img src=""cid:miniplane.jpg"" alt=""Image Missing"" width=""600"" height=""160"" style=""display: block;"" />"
.Display
End With
End Sub
Firstly, don't use HTMLBody as an intermediate variable - reading and setting it is expensive. Use a local variable to build HTML , then set HTMLBody property only once.
If you are setting img tag through the src attribute, you must set the PR_ATTACH_CONTENT_ID property - see How to add images from resources folder as attachment and embed into outlook mail body in C#
Sub ColdEmail()
Dim OutLookApp As Object
Dim OutLookMailItem As Object
Dim lastrow As Long
Dim iCounter As Long
Dim MailDest As String
Dim subj As String
Dim bod As String
Dim ws As Worksheet
Dim signature As String
lastrow = ThisWorkbook.Worksheets("Prospects").Cells(Rows.Count, "D").End(xlUp).Row 'change worksheet
For iCounter = 2 To lastrow
Set OutLookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutLookApp.CreateItem(0)
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
With OutLookMailItem
subj = ""
MailDest = ""
bod = ""
If Cells(iCounter, 13) = "*" Then
subj = Cells(iCounter, 14).Value
MailDest = Cells(iCounter, 7).Value
bod = Cells(iCounter, 16).Value
.BCC = MailDest
.Subject = subj
.HTMLBody = bod & signature
.Send
End If
End With
Next iCounter
End Sub
The code above sends emails automatically to a column of e-mail addresses and it gets the body paragraph from a column in Excel as well.
I wanted my messages to include my default signature in Outlook, so I changed my code to HTMLbody.
The e-mails sent out don't retain the original paragraph spacing:
line 1
line 2
line 3
It looks like this now: line1 line2 line3.
I would echo Scott Holtzman's advice to read up on HTML. Whenever I've needed to do HTML formatting in an email, I've found that <br> is the most straightforward option. Using one <br> will move text to the next line. To create white space, (like, a blank line between paragraphs) use <br><br>.
You can put this right into the cell where your text is located. The brackets will mark this as HTML and it will be rendered in the email as a break rather than as readable text.
In other words: Thanks,<br>Cthulhu in your excel cell, will render as
"Thanks,Cthulhu" in your email.
It would serve you well to read up on coding HTML.
For now, you can do this:
To load the default signature (already set in outlook), you can do the below (and eliminate your code to get the signature):
With OutLookMailItem
.Display
signature = .HTMLBody
....
To format the HTML for the body you can do something like this:
'change font info as needed
bod = "<BODY style=font-size:12pt font-family:Times New Roman font-color:blue>" _
& "<p>" & Cells(iCounter, 16).Value & "</p>" _
& "</BODY>" _
& signature