Copy word doc body to outlook email: RTE 5 - excel

I am trying to copy all of content of a word doc into a Outlook email body while keeping the format and was looking to follow the solution found on this post but am getting an error on the following line: .BodyFormat = olFormatRichText. When the error handler is removed, I get RTE5: Invalid procedure call or argument
Any idea why this line is throwing an error or how to correct?
Sub Sender(Target As Range)
Dim OutApp As Object
Dim OutMail As Object
Dim wd As Object
Dim editor As Object
Dim doc As Object
Dim fp As String
fp = "C:\Users\urdearboy\"
Set wd = CreateObject("Word.Application")
Set doc = wd.documents.Open(fp & "mydearfile.docx")
doc.Content.Copy
doc.Close
Set wd = Nothing
On Error GoTo BNP:
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.SentOnBehalfOfName = "urdearboy#so.com"
.to = Target.Offset(, 2)
.Subject = "Hi Mom"
.BodyFormat = olFormatRichText '<----- ERROR LINE
Set editor = .GetInspector.WordEditor
editor.Content.Paste
.Display
'.Send
Target.Offset(, -1) = "Sent"
End With
BNP:
Set OutApp = Nothing
Set OutMail = Nothing
End Sub
Context: I decided to go with the Word to Outlook copy because the file has a lot of formatting and photos and getting the right format strictly in Outlook HTML sounds like a nightmare. If done manually, this would essentially be a complete CTRL + A + Copy from word and CTRL + V in Outlook which keeps all formatting, photos, and gifs with correct format. The goal here is to mimic that process in VBA. If there is a better solution, open to thoughts there as well

If you're late-binding, then add:
Const olFormatRichText As Long = 3
(seems like you didn't have Option Explicit on too...)
You can find the appropriate value of olFormatRichText here.

Related

Error populating email body from word documents

I am working on an excel macro to send a series of emails each with a unique attachment, and one of three template emails that are saved as word documents. Everything is working well, except pulling the body of the email in from the word document. The problem seems to be with WordEditor. I get the following error
Err.Description:The operation failed.
Err.Number:-2147467259
Err.Source:Microsoft Outlook
Here is the code I have tried:
Sub SendDCLEmails()
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim WordApp As Object
Dim WordDoc As Object
Dim DCLFile As String 'Attachment that differs for each email
Dim DCLCount As Integer 'Number of emails that will be sent
Dim toList As String
Dim ccList As String
Dim CoverLetter As String 'Word document template email
Dim fileCheckDCL As String
Dim fileCheckCover As String
Dim editor As Object
'Set references to Outlook
On Error Resume Next
Set OutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set OutlookApp = New Outlook.Application
On Error GoTo 0
'Set references to Word
On Error Resume Next
Set WordApp = GetObject(, "Word.Application")
If Err <> 0 Then Set WordApp = New Word.Application
On Error GoTo 0
Sheets("Contacts").Select
'Create email for each record on "Contacts" tab
DCLCount = ActiveSheet.UsedRange.Rows.Count - 1
For i = 1 To DCLCount
DCLFile = Range("AD1").Offset(i, 0).Value & "\" & Range("AE1").Offset(i, 0).Value
CoverLetter = Range("AF1").Offset(i, 0).Value
fileCheckDCL = Dir(DCLFile)
fileCheckCover = Dir(CoverLetter)
'Run some validations and generate the toList and ccList variables.
Set WordDoc = WordApp.Documents.Open(CoverLetter)
WordDoc.Content.Copy
'Create Emails
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.Display
.To = toList
.CC = ccList
.Subject = Range("AG1").Offset(i, 0).Value
Set editor = .GetInspector.WordEditor 'This is where the error occurs.
editor.Content.Paste
.Attachments.Add DCLFile
.Send
End With
WordDoc.Close savechanges:=False
End If
toList = vbNullString
ccList = vbNullString
CoverLetter = vbNullString
DCLFile = vbNullString
fileCheckDCL = vbNullString
fileCheckCover = vbNullString
Set editor = Nothing
Next i
OutlookApp.Quit
WordApp.Quit
End Sub
There is no need to use late and early-binding technologies in the VBA macros:
Set OutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then Set OutlookApp = New Outlook.Application
Instead, you need to use one or another. Read more about that in the Using early binding and late binding in Automation article. I'd suggest declaring all objects with real classes (early-binding), it may allow avoiding mistakes with syntax further. And use the New operator in the code instead of CreateObject one.
Set editor = .GetInspector.WordEditor 'This is where the error occurs.
Calling the WordEditor property may sometimes fail if the Inspector is not yet visible and initialized. Try to call the Display method prior getting the Word editor value.
Also instead of relying on Word documents as templates you may create templates in Outlook and use the Application.CreateItemFromTemplate method which creates a new Microsoft Outlook item from an Outlook template (.oft) and returns the new item. Read more about that in the article which I wrote for the technical blog, see How To: Create a new Outlook message based on a template.

Generate an email with a range from a worksheet?

I'm new to this and got my first Excel macro working yesterday. I've create a command button on Excel to set up an email and I want to send a range from the worksheet. I would like it to keep the formatting if possible. I believe the issue is with:
xMailBody = ThisWorkbook.Activeworksheet("Sheet1").Range("AA65:AE67")
Everything else worked okay.
Thank you very much.
Sonny
Private Sub CommandButton1_Click()
'Updated by 2022/09/16
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = ThisWorkbook.Activeworksheet("Sheet1").Range("AA65:AE67")
On Error Resume Next
With xOutMail
.To = Range("AD69")
.CC = ""
.BCC = ""
.Subject = Range("AD70")
.Body = xMailBody
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub
You have xMailBody declared as a string then are stating that it is the desired range.
Try DIMing it as a range!
First of all, I've noticed that you are trying to set the Body property which is a plain text string:
.Body = xMailBody
If you need to preserve formatting you can create a well-formed HTML formatting and then assign it to the HTMLBody prperty of Outlook items.
The Outlook object model supports three main ways of customizing the message body:
The Body property returns or sets a string representing the clear-text body of the Outlook item.
The HTMLBody property of the MailItem class returns or sets a string representing the HTML body of the specified item. Setting the HTMLBody property will always update the Body property immediately. For example:
Sub CreateHTMLMail()
'Creates a new e-mail item and modifies its properties.
Dim objMail As Outlook.MailItem
'Create e-mail item
Set objMail = Application.CreateItem(olMailItem)
With objMail
'Set body format to HTML
.BodyFormat = olFormatHTML
.HTMLBody = "<HTML><BODY>Enter the message text here. </BODY></HTML>"
.Display
End With
End Sub
The Word object model can be used for dealing with message bodies. In that case you can just copy the required range in Excel and then paste to the message directly using the Paste method from the Word object model. See Chapter 17: Working with Item Bodies for more information.
Also you may consider using the RangetoHTML function to convert Excel data to the HTML markup.

Open Email Attachments File

I have open attachments file using following code
Sub Test()
Dim path As String
Dim msgFile As String
path = Application.ActiveWorkbook.path + "\"
file = path & "\*.msg"
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.mailitem
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItemFromTemplate(file)
On Error Resume Next
With OutMail
.To = Application.User
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
But
Email attachments file was not open.
How to Open Email Attachments File in Macro?
The Application class from the Excel object model doesn't provide the User property. Instead, you could use the UserName property which returns the name of the current user.
MsgBox "Current user is " & Application.UserName
The MailItem.To property returns or sets a semicolon-delimited string list of display names for the To recipients for the Outlook item. But I would suggest using the Recipients collection which should be used to modify the To property.

Excel to email with replace text in Premade Email Template

I'm using the below code to auto-generate an email.
Public Function GenerateEmail(sendToText As String, _
sendCCText As String, sendBCCText As String, _
subjectText As String, fileName As String)
Application.ScreenUpdating = False
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItemFromTemplate(fileName)
With OutMail
.sendTo = sendToText
.CC = sendCCText
.BCC = sendBCCText
.Subject = subjectText
.HTMLbody = WorksheetFunction.Substitute(OutMail.HTMLbody, "%TESTNUM%", "98541")
.Attachments.Add (Application.ActiveWorkbook.FullName)
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Function
My end goal is to add data into the email and attach the active document into it as well. Everything here is working as intended, except the .HTLMbody section. It's giving me an error
"Unable to get the Substitute property of the WorksheetFunction
class."
Am I missing a reference to a library? Should I be using something different?
The email is saved as .oft format, so I have a line in the email that has %TESTNUM% that I'm looking to replace with 98541 (or any other string I need to pass into the function)
I have HTML email working in Excel using very similar code. The difference is that I build a temporary string with the text and you could do your substitute code on the string.
Then you can simply use:
.HTMLbody = temp_string
It might not be as elegant but it will help you work out where the problem is.

How to send email with shapes as a image in vba?

I got a*.xls file which contains a plugin generated shapes which forms a chart.
How can I send those shapes as an image acompany with some text in a email using VBA?
I know how to get the shapes in VBA, but don't know how to convert them into a single image.
FYI: I can not install any software or programming environment on my working computer. MS Office is only what I've got.
Excel Vba has a CopyPicture Method on the chart object that you can use to copy a chart to the clipboard and then paste to the image into a new email. I will post a quick demo when I get the chance, but hopefully this will point you in the right direction. Also look at this question as it may help as well.
EDIT
Found that you can also Export a chart as an image.
Try this, I have tested this and it does work.
Sub SendMail()
Dim OutApp As Object
Dim OutMail As Object
Dim myChart As ChartObject
Set myChart = Me.ChartObjects(1)
Dim myFilename As String
myFilename = "c:\temp\test.png"
On Error Resume Next
Kill myFilename
On Error GoTo 0
myChart.chart.Export myFilename, "PNG"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
' Change the mail address and subject in the macro before you run it.
With OutMail
.To = "test#test.com"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hello World!"
.Attachments.Add myFilename
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Resources