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 个错误出现在最后，并在代码中进行了标记。 （错误可能发生在 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

Make sure to Reference to Microsoft Word & Outlook xx.x Object Library

MSDN Paragraphs.SpaceAfter property (Word)

MSDN Range.PasteAndFormat method (Word)

MSDN PasteAndFormat Method

MSDN WdPasteDataType enumeration (Word)