Send Outlook Email with some Bold Text - excel

I have code that opens up an Outlook email with the content of the mail body, but none of the format is working.
In the email, it just shows up as a string Like:
<strong>Bold this part</strong>Unbold this text
<b>This text bold</b>Test
I have been searching answers here, but none of them work.
Here is my code so far:
Sub Send_email()
Dim OutApp As Object
Dim OutMail As Object
Dim MailBody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
MailBody = "First line of email" & vbNewLine & vbNewLine & _
"<strong>Bold this part</strong>" & "Unbold this text" & vbNewLine & _
"<b>This text bold</b>" & "Test"
On Error Resume Next
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Email Subject"
.Body = MailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Use MailItem.HTMLBody instead of MailItem.Body.
Returns or sets a String representing the HTML body of the specified item. Read/write.
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "Email Subject"
.HTMLBody = MailBody
.Display 'or use .Send
End With

Related

How to add JPG file at specific location in email body created from a template?

I'm trying to distribute emails using an Outlook oft template.
On the oft template, at a specific location, I want to attach a jpg file which I have created from Excel range.
Dim OutApp As Object
Dim OutMail As Object
Dim str_jpeg_file as String
str_jpeg_file = "B:\temp\test.jpg"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItemFromTemplate(ThisWorkbook.Path & "\Test.oft")
With OutMail
.To = "test#abcd.com"
.CC = ""
.BCC = ""
.Subject = "Test mail"
.SentOnBehalfOfName = "zyz#abcd"
.Attachments.Add str_jpeg_file, 1, 0
.HTMLBody = Replace(.HTMLBody, "##IMAGE_PLACEHOLDER##", "<img src=""cid:test.jpg""height=520 width=750>")
'.Send
.display
End With
Edit:
jpg file path updated i.e. str_jpeg_file
To give you a full working example:
Option Explicit
Sub test()
Dim OutApp As Object
Dim OutMail As Object
Dim str_jpeg_file As String
str_jpeg_file = "C:\Temp\test.png"
Set OutApp = CreateObject("Outlook.Application")
'Set OutMail = OutApp.CreateItemFromTemplate(ThisWorkbook.Path & "\Test.oft")
'instead of a template I create a new mail
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = "test#abcd.com"
.CC = ""
.BCC = ""
.Subject = "Test mail"
.SentOnBehalfOfName = "zyz#abcd"
.Attachments.Add str_jpeg_file, 1, 0
'first we write some placeholder text so we can replace it
.HTMLBody = "lalala ##IMAGE_PLACEHOLDER## lala"
'replace
.HTMLBody = Replace(.HTMLBody, "##IMAGE_PLACEHOLDER##", "<img src=""cid:test.png""height=256 width=256>")
'.Send
.display
End With
End Sub
Note that I used a new email (no template) because it is easier to show here.
And it works perfectly:
So if it doesn't work for you either your image file is no valid image or you did something else wrong like typos etc. or your template is somehow the issue. Check again with the code above.

Sending outlook emails from Excel

I have the below VBA that sends an email fine:
With Sendrng
' Select the worksheet with the range you want to send
.Parent.Select
'Remember the ActiveCell on that worksheet
Set rng = ActiveCell
'Select the range you want to mail
.Select
' Create the mail and send it
ActiveWorkbook.EnvelopeVisible = True
With .Parent.MailEnvelope
' Set the optional introduction field thats adds
' some header text to the email body.
.Introduction = ""
With .Item
.To = "123#321.com"
.CC = ""
.BCC = ""
.Subject = "A new deli pre-order has been received."
.Send
End With
The part where I am now struggling is to set who the email has come from
I thought adding the below would work:
.From = "111#222.com"
What happens when adding the above:
No email is received at all
What am I missing?
You can try .SendUsingAccount to select the account which you are going to send the e-mail.
With .Item
.SendUsingAccount = olAccount 'or some other account.
.To = "123#321.com"
.CC = ""
.BCC = ""
.Subject = "A new deli pre-order has been received."
.Send
End With
You're probably looking for .SenderEmailAddress or .SentOnBehalfOfName.
Try it this way.
Sub Mail_workbook_Outlook_1()
'Working in Excel 2000-2016
'This example send the last saved version of the Activeworkbook
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.to = "ron#debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
https://www.rondebruin.nl/win/s1/outlook/amail1.htm

Send Outlook email using text in an Excel textbox - Error 424: Object required

I am trying to send an email with Outlook using text in a textbox (I named it tx in Excel) as body.
When I run the code, there is an error on the line:
strbody = tx.Text
Error 424: Object required
Sub SendMail()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
strbody = tx.Text
'On Error Resume Next
With OutMail
.To = "..."
.CC = ""
.BCC = ""
.Subject = Cells(3, 2)
.Body = strbody
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Replace Sheet's name by the name of the sheet where your textbox is
in strbody = ThisWorkBook.Sheets("Sheet's name").Shapes("tx").ControlFormat.Value
Sub SendMail()
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
strbody = ThisWorkBook.Sheets("Sheet's name").Shapes("tx").ControlFormat.Value
'On Error Resume Next
With OutMail
.To = "..."
.CC = ""
.BCC = ""
.Subject = Cells(3, 2)
.Body = strbody
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
You could use CDO? Here's some quick VBA code I put in a test function in Excel VBA (with the email addresses and SMTP server address redacted):
Sub test()
Dim strbody As String
strbody = "Test Email" & vbNewLine & vbNewLine & "TEST EMAIL"
Dim iMsg As Object
Set iMsg = CreateObject("CDO.Message")
With iMsg
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
= "whateverYourSMTPServerIs"
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") _
= 25
.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") _
= 2 'Stands for sending using CDO
.Configuration.Fields.Update
.To = "someemail#someplace.com"
.CC = ""
.BCC = ""
.From = "someemail#someplace.com"
.Subject = "Test Email"
.TextBody = strbody
.Send
End With
End Sub

Issue with HYPERLINK

It is probably a very small thing I am missing, but I can't seem to spot the issue.
Sub sendemail()
'Save the form with todays date
Application.Save Format(Now, "dd-mm-yy") & ".xls"
'Create the email
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<HTML><BODY>"
strbody = strbody & "<A href= http://ne-xxx.xxx.xxx.xxx.biz/ASP/SFP/BHGP/xxUK-OPS/Shared%20Documents/xxx/AllItems.aspx?RootFolder=%2fAxP%2fASP%2fBP%2fNUK%2dOPS%2fShared%20Documents%2f60%2e%20Shift%20Schedule&FolderCTID=&View=%7b1A03DBA9%2d7CEB%2d466F%2d8EA8%2dDDE03D95CDC0%7d>URL</A>"
strbody = strbody & "</BODY></HTML>"
On Error Resume Next
With OutMail
.To = "[xxxx#xx]"
.cc = ""
.BCC = ""
.Subject = "New Holiday Request on " & Format(Now(), "dd/mm/yyyy") & " by " & Range("C2") & ""
.Body = strbody
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
Debug.Print strbody
End Sub
End result should just be a hyperlink in an email...but it's displaying:
http://ne-xxx.xxxx.xxx.xxxx.xxx/sSP/SXP/BJHJP/xxx-OPS/Shared%20Documents/Forms/AllItems.aspx?RootFolder=%2fASP%2fSsP%2foP%2fNBXUK%2dOPS%2fShared%20Documents%2f60%2e%20Shift%20Schedule&FolderCD=&View=%7b1A03DBA9%2d7CEB%2d466F%2d8EA8%2dDDE03D95CDC0%7d>URL
please use below code block
strbody = strbody & "URL"
.HTMLBody = strbody instead of Body
Change
.Body = strbody
to
.HTMLBody = strbody
My sample vbs code worked with or without the quotes
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<HTML><BODY>"
strbody = strbody & "<A href=http://ne-xxx.xxx.xxx.xxx.biz/ASP/SFP/BHGP/xxUK-OPS/Shared%20Documents/xxx/AllItems.aspx?RootFolder=%2fAxP%2fASP%2fBP%2fNUK%2dOPS%2fShared%20Documents%2f60%2e%20Shift%20Schedule&FolderCTID=&View=%7b1A03DBA9%2d7CEB%2d466F%2d8EA8%2dDDE03D95CDC0%7d>URL</A>"
strbody = strbody & "</BODY></HTML>"
With OutMail
.To = "pankaj.jaju#stackoverflow.com"
.HTMLBody = strbody
.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing

Add attachment with varying date in file name to Outlook mail

I have an Excel file named "Home Audio for Planning (28-3-2013).
The date will change every day but the text will be the same.
How do I attach those files to Outlook?
Sub Test()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hello World!"
.Attachments.Add ("C:\Users\Desktop\Today\Home Audio for Planning (28-3-2013).xlsx")
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Try below code : strLocation will be generated dynamically. You can just pass this variable to your attachments. File name generated would be like Home Audio for Planning_28-03-2013.xlsx
Sub Test()
Dim strLocation As String
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = ""
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hello World!"
strLocation = "C:\Users\Desktop\Today\Home Audio for Planning" & Format(Now(), "_DD-MM-YYYY") & ".xlsx"
.Attachments.Add (strLocation)
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Easy,
.Attachments.Add ("C:\Users\Desktop\Today\Home Audio for Planning (" & FORMAT(DATE,DD-MM-YYYY)")
Did you try to change the attachemnt name dynamic. For ex;
.Attachments.Add ("C:\Users\Desktop\Today\Home Audio for Planning (" + timeVariable + ").xlsx")
and you can set the time variable before to match the date of the date in the required format.
Cheers
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim strSubject As String
Dim StrSub As Integer
Dim AttachCnt As Integer
AttachCnt = Item.Attachments.Count
strSubject = Item.Subject
StrSub = Len(strSubject)
strBody = Item.Body
strBod = InStr(1, UCase(strBody), "ATTACH")
cnsolidateMsg = ""
If strBod <> 0 And AttachCnt = 0 Then
cnsolidateMsg = cnsolidateMsg & "Attachment is Null." & vbNewLine
End If
If StrSub = 0 Then
cnsolidateMsg = cnsolidateMsg & "Subject is Empty." & vbNewLine
End If
If UCase(Trim(strSubject)) = "FW:" Then
cnsolidateMsg = cnsolidateMsg & "Forward mail subject is empty." & vbNewLine
End If
If UCase(Trim(strSubject)) = "RE:" Then
cnsolidateMsg = cnsolidateMsg & "Reply mail subject is empty." & vbNewLine
End If
If cnsolidateMsg <> Empty Then
If MsgBox(cnsolidateMsg & vbNewLine & "Are you sure you want to send the Mail?", vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check for send mail") = vbNo Then
Cancel = True
End If
End If
End Sub
With OutMail
.To = ""
.BodyFormat = olFormatHTML '---Default
.Attachments.Add ("C:\Users\Desktop\Test.txt")
.Display
End With
If not.BodyFormat = olFormatHTMLfile will be attached in the mail body

Resources