excel - 在特定单元格中使用带有电子邮件地址的 VBA 发送电子邮件 - 此方法不支持对象

Question

我正在尝试为宏制作代码，该代码应该将工作表与新工作簿分开，保存它们并在电子邮件中附加文件。但是在某些部分我得到“运行时错误'440'：此方法不支持对象” - 这是宏应该选择某些单元格以从中获取电子邮件地址的部分。当我点击“调试”并手动继续使用宏而不进行更改时，它将按预期工作，但不知何故，我总是遇到错误，需要手动调试和恢复宏。

Sub Split_To_Workbook_and_Email()
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim sh As Worksheet
    Dim DateString As String
    Dim FolderName As String
    Dim myOutlook As Object
    Dim myMailItem As Object
    Dim myPath As String
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    Set otlApp = CreateObject("Outlook.Application")
        
    Set Sourcewb = ActiveWorkbook
    DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")
    FolderName = "C:\Users\user\Desktop\" & Sourcewb.Name & " " & DateString
    MkDir FolderName
    For Each sh In Sourcewb.Worksheets
        If sh.Visible = -1 Then
            sh.Copy
            Set Destwb = ActiveWorkbook
            With Destwb
                If Val(Application.Version) < 12 Then
                    FileExtStr = ".xls": FileFormatNum = -4143
                Else
                    If Sourcewb.Name = .Name Then
                        MsgBox "Your answer is NO in the security dialog"
                        GoTo GoToNextSheet
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                End If
            End With
            If Destwb.Sheets(1).ProtectContents = False Then
                With Destwb.Sheets(1).UsedRange
                    .Cells.Copy
                    .Cells.PasteSpecial xlPasteValues
                    .Cells(1).Select
                End With
                Application.CutCopyMode = False
            End If
            Set otlNewMail = otlApp.CreateItem(olMailItem)
            With Destwb
                .SaveAs FolderName _
                      & "\" & "Name " & DateString & " " & Destwb.Sheets(1).Name & FileExtStr, _
                        FileFormat:=FileFormatNum
            End With
            myPath = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
            
            With otlNewMail
                .To = ActiveSheet.Range("C4")
                .CC = "[e-mail]"
                .Subject = "Subject"
                .Body = "message" 
                .Attachments.Add myPath
                .Display
            End With
            
            With Destwb
                .Close False
            End With
            
            Set otlNewMail = Nothing
        End If
GoToNextSheet:
    Next sh
    MsgBox "Files saved in" & FolderName
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

这部分出现问题，第二行：

        With otlNewMail
            .To = ActiveSheet.Range("C4")
            .CC = "[e-mail]"
            .Subject = "Subject"
            .Body = "message" 
            .Attachments.Add myPath
            .Display
        End With

标签： excelvba