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)

之前未打开任何电子邮件时，VBA运行时错误91/4605

1 个答案: