excel - 将数据粘贴到 Outlook 邮件正文时 - 我收到错误 4506“应用程序已锁定以进行编辑”

Question

我必须编写一个包含来自多个来源的文本的邮件正文。

但是行 editor.Application.Selection.Paste 给出错误“4505”应用程序在编辑时被锁定

我从 3 个来源多次粘贴以创建许多邮件

Dim Outapp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim wd, cmmtrs, ftnt As Object
Dim editor As Object
Dim savePath As String
Dim filePath As String

Dim lastRow As Integer: lastRow = Sheet2.Range("D20000").End(xlUp).Row
filePath = Application.ActiveWorkbook.Path
savePath = filePath & "\" & Format(Now(), "yyyy-mm-dd")
Set wd = CreateObject("Word.Application")
Set cmmtrs = wd.Documents.Open(savePath & "\ABC.docx", ReadOnly:=True)

'create multiple emails 
For i = 2 To lastRow
    Set Outapp = CreateObject("Outlook.Application")
    Set OutMail = Outapp.CreateItem(olMailItem)
    Set vInspector = OutMail.GetInspector
    Set editor = vInspector.WordEditor


    With OutMail
        .To = Sheet2.Range("B" & i).Value
        .CC = Sheet2.Range("C" & i).Value
        .Subject = Sheet2.Range("D" & i).Value
        .Body = Sheet2.Range("E" & i).Value & vbCrLf & vbNewLine
        Dim lst As Integer: lst = Sheet3.Cells(1000, Sheet3.Range("A3:XAA3").Find(i - 1).Column).End(xlUp).Row
        Dim col1, col2 As Integer: col1 = Sheet3.Range("A3:XAA3").Find(i - 1).Column
        .Display
    End With

    With OutMail
      If Sheet3.Range("A3:XAA3").Find(i) Is Nothing Then
            col2 = Sheet3.Cells.Find(What:="*", After:=Sheet3.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
        Else
            col2 = Sheet3.Range("A3:XAA3").Find(i).Column - 1
        End If
        Sheet3.Range(Sheet3.Cells(4, col1), Sheet3.Cells(lst + 1, col2)).Copy
        editor.Application.Selection.Start = Len(.Body)
        editor.Application.Selection.End = editor.Application.Selection.Start
        Application.Wait (Now + 0.0001)

        editor.Application.Selection.Paste
    End With

    If Sheet2.Range("G" & i) = "Yes" Then
        cmmtrs.Content.Copy
        With OutMail
            editor.Application.Selection.Start = Len(.Body)
            editor.Application.Selection.End = editor.Application.Selection.Start
            Application.Wait (Now + 0.00005)
            editor.Application.Selection.Paste
        End With
    End If

标签： excelvbaoutlookms-word