运行时错误，用于电子邮件自动化的 VBA EXCEL

Question

我一直在使用 vba 为 excel 进行电子邮件自动化，我的代码仅适用于第一封电子邮件，并且在下一封邮件中出现运行时错误，

我尝试将对象设置为无济于事..

我不知道内存泄漏在哪里

有人能指点一下吗

错误出现在对象备注处。我已经提供了错误的屏幕截图..

模块名称 = 自动邮件

Public PublicRow As Integer
Dim mark As New Remarks

Sub Button_Click()

Dim LastR As Long
Dim CRow As Long
Dim sSendTo As String
Dim sSendCC As String
Dim sSendBCC As String
Dim sSubject As String
Dim txt As String
Dim OutApp As Object
Dim OutMail As Object


Set OutApp = CreateObject("Outlook.Application")
Set mark.item = Nothing

OutApp.Session.Logon

LastR = Cells(Rows.Count, 2).End(xlUp).Row

For CRow = 3 To LastR
    If Cells(CRow, 6) <> "Email sent" Then
        If Cells(CRow, 3) <= Date Then

            Set OutMail = OutApp.CreateItem(0)
            Set mark.item = OutMail

            sSendTo = Cells(CRow, 5)
            sSendCC = ""
            sSendBCC = ""
            sSubject = "Project Due Date"
            PublicRow = CRow

            With OutMail
                .To = sSendTo
                If sSendCC > "" Then .CC = sSendCC
                If sSendBCC > "" Then .BCC = sSendBCC
                .Subject = sSubject

                txt = "Dear " & Cells(CRow, 4) & ", "
                txt = txt & vbCrLf & vbCrLf
                txt = txt & "The due date has been reached for the 
 project:"
                txt = txt & vbCrLf & vbCrLf
                txt = txt & "    " & Cells(CRow, 2)
                txt = txt & vbCrLf & vbCrLf
                txt = txt & "Please take the appropriate actions."
                txt = txt & vbCrLf & vbCrLf
                txt = txt & "Regards,"
                txt = txt & vbCrLf
                txt = txt & "Danial"

                .Body = txt
                .Display (True)
            End With

            Set OutMail = Nothing

        End If
    End If
Next CRow

Set mark.item = Nothing
Set OutApp = Nothing

End Sub

类名 = 备注

Option Explicit

Public WithEvents item As Outlook.MailItem

Private Sub item_Close(Cancel As Boolean)

Dim boolSent As Boolean

boolSent = item.Sent

If Err.Number = 0 Then
    Cells(PublicRow, 6) = "Email not sent"
    Cells(PublicRow, 7) = "X"
Else
    Cells(PublicRow, 6) = "Email sent"
    Cells(PublicRow, 7) = Now()
End If

End Sub

错误：

Answer 1

清理了一下代码，我无法测试它，因为我不知道备注类是什么。 还有一些看起来很奇怪的东西，automail 是一个什么样的模块（class/UF/module）？ Button_Click 看起来有点像 UserForm，在这种情况下我建议阅读：https://rubberduckvba.wordpress.com/2017/10/25/userform1-show/

Public PublicRow As Integer

Sub Button_Click()


    Dim LastR As Long
    Dim CRow As Long
    Dim sSendTo As String
    Dim sSubject As String
    Dim bodyTxt As String
    Dim OutApp As Object
    Dim OutMail As Object

    Set OutApp = CreateObject("Outlook.Application")

    Dim mark As Remarks
    Set mark = New Remarks
    'This is the "usual" way to instantiate an object, see here: https://stackoverflow.com/a/42656772/10223558

    Set mark.item = Nothing ' why set it to nothing here, usually this would happen in the class itself?

    OutApp.Session.Logon

    LastR = Cells(Rows.Count, 2).End(xlUp).Row

    For CRow = 3 To LastR
        If Cells(CRow, 6) <> "Email sent" And Cells(CRow, 3) <= Date Then
            Set OutMail = OutApp.CreateItem(olMailItem) 'use constant name instead of integer, makes it more legible.

            sSendTo = Cells(CRow, 5)
            sSubject = "Project Due Date"
            PublicRow = CRow

            bodyTxt = buildBody(Cells(CRow, 4),  Cells(CRow, 2)

            With OutMail
                .To = sSendTo
                .Subject = sSubject
                .Body = bodyTxt 
                .Display (True)
            End With
            Set mark.item = OutMail
            'shouldn't there be some code to send the mail here?
        End If

    Next CRow
End Sub

Private Function buildBody(ByVal receiverName as String, ByVal projectName as String) as String
    Dim txt As String
    txt = "Dear " & receiverName  & ", "
    Txt = txt & vbCrLf & vbCrLf
    txt = txt & "The due date has been reached for the project:"
    txt = txt & vbCrLf & vbCrLf
    txt = txt & "    " & projectName 
    txt = txt & vbCrLf & vbCrLf
    txt = txt & "Please take the appropriate actions."
    txt = txt & vbCrLf & vbCrLf
    txt = txt & "Regards,"
    txt = txt & vbCrLf
    txt = txt & "Danial"
    buildBody = txt
End Function