运行时错误“ 440”：对象不支持此方法

Question

我尝试发送多封带有附件的电子邮件。宏通过.Send行崩溃，并显示错误440。有时在发送50封电子邮件后崩溃，有时在30、80、100封电子邮件之后崩溃。这可能是错误的吗？

与Outlook，Excel和安全设置有关的问题吗？

我没有在任何站点上找到有关此问题的任何解决方案。

Set rangepro = Worksheets("Mappings").Range("f2:f" & rangeprojects)

For Each cell In rangepro                        'loops every project in rangepro, this name is used later in the filter to generate the files

    Worksheets("27a Report").Range("A1:au" & range27a).AutoFilter Field:=1, Criteria1:=cell.Value

    'Select only the visible cells in active sheet
    Worksheets("27a Report").Select
    Cells.Select
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Copy

    '~~> Source/Input Workbook
    Set wbI = ThisWorkbook
    '~~> Set the relevant sheet from where you want to copy
    'Set wsI = wbI.Sheets("Sheet1")
    Set wbO = Workbooks.Add

    With wbO

        Set wsO = wbO.Sheets("Sheet1")

        ActiveSheet.Name = "27a Report"

        wsO.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                                     SkipBlanks:=False, Transpose:=False

        Call GeneratePivots.CreatePivot1

        Call checkiftravel

        ActiveWorkbook.CheckCompatibility = False

        Application.DisplayAlerts = False

        Path = "\\wrofs1\sd&m\OnePMO\01.Services\03.Operations\05.Industrialization\Tools\27a\" & f & d & "\"

        .SaveAs Filename:=Path & cell.Value & d & "-NBTReport.xls", FileFormat:=56

        .Close

        'send the email
        eSubject = Worksheets("Mail").Range("c2").Value
        eBody = Worksheets("Mail").Range("c5").Value
        eOnBehalf = Worksheets("Mail").Range("c26").Value
        'eAttach = Range("f27").Value

        Set OutApp = CreateObject("Outlook.Application")
        OutApp.Session.Logon
        Set OutMail = OutApp.CreateItem(0)

        With OutMail
            .SentOnBehalfOfName = eOnBehalf
            .To = cell.Offset(0, 1)
            '.cc = ccAll
            .Subject = eSubject
            .body = eBody
            '.Attachments.Add eAttach
            .Attachments.Add Path & cell.Value & d & "-NBTReport.xls"
            .Display
            .Send
        End With

    End With

Next cell