Error when using VBA to send an email from Excel to Outlook

Question

I have been attempting to create a way to send a copied part of my Excel workbook as an email through Outlook. The current Code I have works 9 times out of 10. The 10th time it gives me an error error. The line that Visual Basic is showing as the issue is:

pageEditor.Application.Selection.PasteAndFormat (wdFormatOriginalFormatting)

The full code is here:

Private Sub CommandButton2_Click()

Dim Answer As VbMsgBoxResult

     Answer = MsgBox("Are you ready to submit?", vbYesNo, "Run Macro")

     If Answer = vbYes Then

Dim outlook As Object
Dim newEmail As Object
Dim xInspect As Object
Dim pageEditor As Object
Dim CSVString As String

    Set outlook = CreateObject("Outlook.Application")
    Set newEmail = outlook.CreateItem(0)
    With newEmail
        .To = "email"
        .CC = ""
        .BCC = ""
        .Subject = Sheet1.Range("B2")
        .Display
        Set xInspect = newEmail.GetInspector
        Set pageEditor = xInspect.WordEditor
        Sheet1.Range("B2:D11").Copy
        pageEditor.Application.Selection.Start = 1
        pageEditor.Application.Selection.End = 
 pageEditor.Application.Selection.Start
        .Display
        Application.Wait (Now + TimeValue("0:00:02"))
        pageEditor.Application.Selection.PasteAndFormat 
(wdFormatOriginalFormatting)
        .Display
        .Send
        Set pageEditor = Nothing
        Set xInspect = Nothing
    End With
    Set newEmail = Nothing
    Set outlook = Nothing

    MsgBox "Adjustment Form has been submitted"

    End If

End Sub

It is never consistent.

[copy range to outlook](https://stackoverflow.com/questions/76478079/how-can-i-add-a-worksheet-into-email-body-as-image/76480147#76480147) — Davesexcel, Jun 17 '23 at 09:58

score 1 · Answer 1 · answered Jun 17 '23 at 11:12

If your code relies on waits, it's generally not good code practice. I would recommend taking a different approach. Simply convert the range to HTML and then insert it into your Outlook message. To convert the range to HTML, you can use Ron de Bruin's function (source):

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook

    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With

    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")

    'Close TempWB
    TempWB.Close savechanges:=False

    'Delete the htm file we used in this function
    Kill TempFile

    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

Then, just adapt your main function:

Private Sub CommandButton2_Click()

Dim Answer As VbMsgBoxResult
Answer = MsgBox("Are you ready to submit?", vbYesNo, "Run Macro")
If Answer = vbNo Then Exit Sub

Dim outlook As Object, rng As Range, newEmail As Object, xInspect As Object, pageEditor As Object, CSVString As String
    Set outlook = CreateObject("Outlook.Application")
    Set newEmail = outlook.CreateItem(0)
    Set rng = Range("B2:D11")           'Define your range
    
    With newEmail
        .To = "to@test.com"
        .CC = "cc@test.com"
        .BCC = "bcc@test.com"
        .Subject = Range("B2")          'Define your range
        .HTMLBody = RangetoHTML(rng)
        .Display
        .Send
    End With
    
    Set newEmail = Nothing
    Set outlook = Nothing

End Sub

I have noticed this code does not copy pictures in the range, would you have a solution to that? — Davesexcel, Jul 19 '23 at 11:02

k1dr0ck · Answer 2 · 2023-06-19T12:58:45.257

1

try

Private Sub CommandButton2_Click()

    Dim Answer As VbMsgBoxResult
    Dim MyRange As Range
    Dim doc As Object,x

    Answer = MsgBox("Are you ready to submit?", vbYesNo, "Run Macro")

    If Answer = vbYes Then

    Set MyRange = Sheet1.Range("B2:D11")
    
    With CreateObject("outlook.application").CreateItem(0)
        .Display

        Set doc = .GetInspector.WordEditor
        
        .Body = "This is the body:"'& vbNewLine & vbNewLine
        x = doc.Range.End - 1
        MyRange.Copy
        doc.Range(x).Paste
        
        .To = "someone@somewhere.com"
        .Subject = Sheet1.Range("B2")
        'uncomment .Send to send immediately after testing
        '.Send
        
        Application.CutCopyMode = 0
    End With

    MsgBox "Adjustment Form has been submitted"

    End If
    
End Sub

edited Jun 19 '23 at 12:58

answered Jun 17 '23 at 12:04

k1dr0ck

1,043
4
13

Did you test this code before submitting it? – Davesexcel Jun 18 '23 at 22:37
@Davesexcel yes, works on my side :) – k1dr0ck Jun 19 '23 at 03:03
1

Did you change .Display to .Send and run it? – Davesexcel Jun 19 '23 at 09:22
@Davesexcel i have not, just used the `.Display` ,thank you for pointing it out, edited the code – k1dr0ck Jun 19 '23 at 12:52

Error when using VBA to send an email from Excel to Outlook

2 Answers2