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.
Related
I frequently have to send out emails to various contractors to check in on the statuses of the projects I have bid with them. Currently I have to enter the name of each Rep in reference cell and then execute the macro but I deal with dozens of reps. I would like to be able to send an bulk email blast out to all the reps whose projects are still "Open" with one macro instead of having to change the reps name each time. Also, I tried to use the automatic .send function but cannot get it to work and I would hope to not have to keep using the .display for this situation for obvious reasons.
Sub EmailGCs_1()
'Declare Outlook Variables
Dim oLookApp As Outlook.Application
Dim oLookItm As Outlook.MailItem
Dim oLookIns As Outlook.Inspector
'Declare Word Variables
Dim oWrdDoc As Word.Document
Dim oWrdRng As Word.Range
Dim oWrdTble As Word.Table
'Declare Excel Variables
Dim ExcTbl As ListObject
On Error Resume Next
'Get The Active instance of Outlook, if there is one.
Set oLookApp = GetObject(, "Outlook. Application")
'If ther is no active instance create one
If Err.Number = 429 Then
'Create a new instance
Set oLookApp = New Outlook.Application
End If
'Create a new Email
Set oLookItm = oLookApp.CreateItem(olMailItem)
'Create a refernce to the table
Set Exltbl = ActiveSheet.ListOjects(1)
With oLookItm
'Basic Info
.To = Range("D2").Value
.Subject = "Various Project Statuses"
'Display Email
.Display
'Get The Inspector
Set oLookIns = .GetInspector
'Get the Word Editor
Set oWrdDoc = oLookIns.WordEditor
'Filter Table to Distro
ActiveSheet.Range("Table1").AutoFilter field:=6, Criteria1:=Cells(1, 6).Value
'Hide Columns
Range("G:R").EntireColumn.Hidden = True
'Copy Items
Worksheets(1).ListObjects("Table1").Range.Copy
oWrdDoc.Range(1, 2).Paste
'Greeting Text
MsgText = Split(Range("F1").Value, " ")(0) & "," & vbNewLine & "Can you please let me know the statuses of the projects below." & vbNewLine
oWrdDoc.Range.InsertBefore Text:=MsgText
'Clearing out filter and selection
ActiveSheet.ListObjects(1).AutoFilter.ShowAllData
Application.CutCopyMode = False
Range("G:R").EntireColumn.Hidden = False
End With
Set oLookItm = Nothing
Set oLookApp = Nothing
Application.ScreenUpdating = True
End Sub
The Send method is not safe and the Outlook object model may trigger security prompts or give errors when Outlook is automated from an external application. Possible workarounds are listed below:
Create a COM add-in which deals with a safe Application instance which doesn't trigger security prompts.
Use a low-level code on which Outlook is built on and which doesn't have security riggers onboard. Or may also consider any other third-party wrappers around that API, for example, Redemption.
Use a third-party components for suppressing Outlook security warnings. See Security Manager for Microsoft Outlook for more information.
Use group policy objects for setting up machines.
Install any AV software with latest updates.
Here is one way to loop through a list.
Source: Sending Email to a List of Recipients Using Excel and Outlook
Option Explicit ' Consider this mandatory
' Tools | Options | Editor tab
' Require Variable Declaration
' If desperate declare as Variant
Sub EmailGCs_2()
' Early binding requires reference to Microsoft Outlook XX.X Object Library
' Declare Outlook variables
Dim oLookApp As Outlook.Application
Dim oLookItm As Outlook.MailItem
Dim iCounter As Long
'Application.ScreenUpdating = False
'There can only be one instance of Outlook
' GetObject is not needed.
' The problematic On Error Resume Next can be dropped
Set oLookApp = New Outlook.Application
'Subsequent errors would have been bypassed
' due to the missing On Error GoTo 0
'If there are any errors you can fix them now.
'Assumes a list of email addresses in column D starting at cell D2
' https://learn.microsoft.com/en-us/office/vba/excel/concepts/working-with-other-applications/sending-email-to-a-list-of-recipients-using-excel-and-outlook
'Debug.Print WorksheetFunction.CountA(Columns(4)) + 1
For iCounter = 2 To WorksheetFunction.CountA(Columns(4)) + 1
'Debug.Print iCounter
'Create a new Email
Set oLookItm = oLookApp.CreateItem(olMailItem)
With oLookItm
'Basic Info
.To = Cells(iCounter, 4).Value
.Subject = "Various Project Statuses"
'Display Email
.Display
End With
Set oLookItm = Nothing
Next
Set oLookItm = Nothing
Set oLookApp = Nothing
Application.ScreenUpdating = True
Debug.Print "Done."
End Sub
I'm calling Outlook from an Excel VBA macro to send an attachment via email. If for some reason an attachment cannot be added to the MailItem, I get the "Array index out of bounds" error when trying to display the MailItem.
When I checked value of MailItem.Attachments.Count, it showed 1, even though attachment was not added to the email. I tried removing the attachment using MailItem.Attachments.Remove 1, but count of attachments still shows 1 and the "Array index out of bounds" error still appears when trying to display.
I've come across this thread, which is about developing Office Add-Ins in C#, and it suggests releasing all COM objects. I'm not sure how to do it and if it's even relevant. I tried setting all objects except the MailItem to Nothing, but that didn't help.
UPD: The question that was suggested in comments does not solve my problem. In that question the wrong object was used to access the Attachments property. Here I'm using Outlook.MailItem.Attachments, which I believe is correct.
Here's the sample code:
Public Sub ForStackOverflow()
Dim OutlookApp As Object
Dim MailItem As Object
Dim Attachments As Object
Dim Attachment As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set MailItem = OutlookApp.CreateItem(0)
With MailItem
.To = "test#test.com"
.Subject = "test"
.Body = "test"
Set Attachments = .Attachments
On Error Resume Next
Set Attachment = Attachments.Add("C:\Temp\ThisFileDoesNotExist.txt")
If Err.Number = 0 Then
On Error GoTo 0
.Send '<-- This works fine because attachment was added successfully
Else
On Error GoTo 0
'Attachment.Delete 'This and any of the below didn't work
'Set Attachment = Nothing
'Attachments.Remove 1
'Set Attachments = Nothing
.Display '<-- Error 440: Array index out of bounds on this line
End If
End With
End Sub
With On Error Resume Next you found there is something indicating there is an attachment, you cannot remove, that triggers an "Array index out of bounds" error.
Test for the file instead of applying the code of last resort, On Error Resume Next.
Option Explicit
Public Sub ForStackOverflow_FileExistsTest()
Dim OutlookApp As Object
Dim MailItem As Object
Dim pathFile As String
Set OutlookApp = CreateObject("Outlook.Application")
Set MailItem = OutlookApp.CreateItem(0)
With MailItem
pathFile = "C:\Temp\ThisFileDoesNotExist.txt"
If Len(dir(pathFile)) > 0 Then
.Attachments.Add (pathFile)
.Display
Else
MsgBox pathFile & " does not exist."
.Display
End If
End With
End Sub
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.
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.
I am trying to write a simple program to automatically send emails from a list in excel, and it works, but outlook keeps opening pop ups asking for permission. How do you get outlook to not ask for permission anymore and just do what excel tells it without the pop ups
Heres the code I have so far:
Sub SendMessage()
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim recemail
Dim i As Integer
i = 1
recemail = Sheet1.Cells(i, 1)
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add(recemail)
objOutlookRecip.Type = olTo
' Set the Subject, Body, and Importance of the message.
.Subject = "TEST!"
.Body = "DOES THIS WORK!?"
' Should we display the message before sending?
If DisplayMsg Then
.Display
Else
.Save
.Send
End If
End With
Set objOutlook = Nothing
i = i + 1
End Sub
This is a manual operation that you need to do :
Run Outlook as Administrator
Go to Tools (Outlook 2007) or File, Options (Outlook 2010 and up)
Go to Trust Center
Change the Programmatic Access setting to : Never warn me about suspicious activity
You can now close Outlook and from now on, you'll have access every time without the popup!
BTW, to avoid opening a new instance of Outlook (if there is already one), use this :
'Create or Get the Outlook session.
On Error Resume Next
Set objOutlook = GetObject(, "Outlook.Application")
If Err.Number > 0 Then Set objOutlook = CreateObject("Outlook.Application")
On Error GoTo 0