Runtime Error, VBA EXCEL for email automation

问题

Ive been working on email automation for excel using vba, my code works only for the first email, and got runtime error on the next,

ive tried setting object to nothing but to no avails..

i dont know where the leak in memory is

can somebody point me up

error is at item at object remark. I've provided a screenshot for the error..

Module Name = Automail

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

Class Name = Remarks

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

Error:

回答1:

Cleaned up the code a bit, I can't test it since I do not know what the remarks class is. There are a few other thing that look strange, what kind of module (class/UF/module) is automail? The Button_Click look suspiciously like a UserForm, in this case I recommend reading: 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

来源：https://stackoverflow.com/questions/57764671/runtime-error-vba-excel-for-email-automation