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

我创建了一个宏，可以发送多封带有附件的电子邮件。宏崩溃，错误为440，位于.Send行。有时它在发送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

---

可能是因为你正在创建20多个Outlook会话和相同数量的电子邮件，而不是关闭它们。尝试在每个循环结束时添加

Set-OutApp=Nothing Set-OutMail=Nothing

，或在循环之前创建一次Outlook应用程序。电子邮件不是在循环结束后关闭的吗？发送？是的，它是关闭的，但我认为重置变量（

=Nothing

）是一个好方法。我尝试了，但仍然存在相同的错误：(