Ошибка выполнения VBA 91/4605, когда электронное письмо не было открыто ранее

Question

У меня есть код в Excel, который копирует таблицу на новый адрес электронной почты:

Option Explicit

Public Sub TESTEMAIL()

Const olMailItem As Long = 0

    Dim StrFile, signature As String
    Dim OutApp As Outlook.Application
    Dim Outmail As Outlook.MailItem
    Set OutApp = CreateObject("Outlook.Application")
    Set Outmail = OutApp.CreateItem(olMailItem)

Dim myRecipient As Object

Set OutApp = CreateObject("Outlook.Application")
Set Outmail = OutApp.CreateItem(olMailItem)

Set OutApp = Nothing

Outmail.Display
Dim wordDoc As Word.Document
Set wordDoc = Outmail.GetInspector.WordEditor

Range("A1:E10").Copy

Dim p1 As Picture
Set p1 = ActiveSheet.Pictures.Paste
p1.Cut


With wordDoc.Application.Selection

    .Start = Len(Outmail.Body)      ' error n° 91 
    .End = .Start
    .PasteSpecial wdPasteBitmap     ' Error n° 4605 or Error n°91

End With

End Sub

Код возвращает ошибку каждый раз, когда я использую его после запуска компьютера:

Код ошибки 91 " Переменная объекта или переменная блока не установлена ​​"

Большую часть времени Outlook не открывался ранее или не было открыто новое электронное письмодо.

Иногда я также получаю код ошибки 4605, в котором говорится, что документ заблокирован от изменений.
2 ошибки идут в конце и помечаются в коде.(ошибка может возникать в двух разных строках)

Иногда все работало, но только если раньше в Outlook открывалось новое электронное письмо (событие, если Outlook закрыто).

Любая подсказка, почему это может бытьи как решить проблему?

Answer 1

Это то, что вы пытаетесь сделать?

Пример

Option Explicit
Public Sub TESTEMAIL()
    Dim OutApp As Outlook.Application
    Set OutApp = CreateObject("Outlook.Application")

    Dim Outmail As Outlook.MailItem
    Set Outmail = OutApp.CreateItem(olMailItem)

    Dim wordDoc As Word.Document
    Set wordDoc = Outmail.GetInspector.WordEditor

    Dim Sht As Excel.Worksheet
    Set Sht = ActiveWorkbook.Sheets("Sheet1")

    Dim rng As Range
    Set rng = Sht.Range("A1:E10")
        rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    With Outmail
        .To = "0m3r@email.com"
        .CC = ""
        .BCC = ""
        .Subject = "Hello"
        .Display

         wordDoc.Paragraphs(1).Range.PasteSpecial Link:=False, _
                                       DataType:=wdPasteBitmap, _
                                       Placement:=wdFloatOverText, _
                                       DisplayAsIcon:=False


         wordDoc.Paragraphs(1).SpaceAfter = 20 ' add space to 12 points

         wordDoc.Range.InsertBefore "Hello 0m3r" & vbCr

         wordDoc.Paragraphs(1).SpaceAfter = 20 ' add space to 12 points


    End With

End Sub

Убедитесь, что вы ссылаетесь на библиотеку объектов Microsoft Word & Outlook xx.x

Свойство MSDN Paragraphs.SpaceAfter (Word)

Метод MSDN Range.PasteAndFormat (Word)

Метод MSDN PasteAndFormat

Перечисление MSDN WdPasteDataType (Word)