Attachments.Add 当文件打开时，使用 Office365，使用在旧版本的 Outlook 中工作的 Outlook VBA

问：

我从 Office 2016 迁移到 Office 365。我有多年的代码。

该代码具有附加文件的选项。如果附加的文件未打开，则它可以正常工作。如果文件已打开，则我会收到以下错误：

运行时错误 '-2147024864 （80070020）

Sub Email(Optional vToAddress As String, Optional vSubject As String, Optional vEmailRange As String = "", Optional vCCAddress As String, Optional vBCCAddress As String = "", Optional vAttachmentFullPath As String)

    Dim OutApp As Object
    Dim OutMail As Object
    Dim olInsp As Object
    Dim xlSheet As Worksheet
    Dim wdDoc As Object
    Dim oRng As Object
        
    If vEmailRange <> "" Then
        Application.GoTo Range(vEmailRange)
        Selection.Copy
    End If
    
    On Error Resume Next
    Set OutApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then Set OutApp = CreateObject("Outlook.Application")
    On Error GoTo 0
        
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = vToAddress
        If vCCAddress <> "" Then .CC = vCCAddress
        If vBCCAddress <> "" Then .BCC = vBCCAddress
        .Subject = vSubject
        .BodyFormat = olFormatHTML
        '.HTMLBody = ""
        If vAttachmentFullPath <> "" And Dir(vAttachmentFullPath) <> "" Then
            .Attachments.Add vAttachmentFullPath
        End If
            
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
            
        If vEmailRange <> "" Then
            oRng.Collapse 1
            oRng.Paste
        End If
           
        .Display
        .Send
    End With
       
    Set OutMail = Nothing
    Set OutApp = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
    Application.CutCopyMode = False

End Sub