运行时错误“ 440”：发送多个Emals时对象不支持此方法

Question

我得到一个

  

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

该宏旨在发送多封不同的电子邮件，并且可以工作到大约500封电子邮件为止。错误所在的行是.To=em或.BCC=""。时间，然后给我错误？

Sub TM_Email()


    Dim AWorksheet As Worksheet
    Dim Sendrng As Range
    Dim Subject As String
    Dim LastRow As Long
    Dim em As String
    Dim y As Long
    Dim Result As Integer


    y = Range("A1").Value

    LastRow = Range("A1048576").End(xlUp).Row

    em = Range("H2").Value

    Subject = "Urgent - action needed!"

    'On Error GoTo StopMacro

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sendrng = ActiveSheet.Range("A2:D" & LastRow)

    'Remember the activesheet
    Set AWorksheet = ActiveSheet

    With Sendrng

        ' Select the worksheet with the range you want to send
        .Parent.Select

        'Select the range you want to mail
        .Select

        ' Create the mail and send it
        ActiveWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope



            With .Item
                .SentOnBehalfOfName = "CompanyEmail"
                .To = em
                .CC = " "
                .BCC = " "
                .Subject = Subject

                If y = 2 Then

                .display

                Result = MsgBox("Does this look ok?", vbYesNo)

                    If Result = vbNo Then


            ActiveWorkbook.EnvelopeVisible = False

                    End
                    End If

                End If

                .Send
            End With

        End With

    End With

    AWorksheet.Select


StopMacro:


With Application
        .ScreenUpdating = False
        .EnableEvents = True
    End With
    ActiveWorkbook.EnvelopeVisible = False

End Sub