发送多封电子邮件：运行时错误“ 440”：对象不支持此方法

Question

我创建了一个宏，该宏发送带有附件的多封电子邮件。宏通过.Send行崩溃，并显示错误440。有时它会在发送50封电子邮件后崩溃，有时是在30封之后崩溃。这可能是错误的吗？

我首先尝试了20个文件，但效果很好。 真的不知道是什么情况，还没有在互联网上找到答案。

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