运行时错误，用于电子邮件自动化的VBA EXCEL [英] Runtime Error, VBA EXCEL for email automation

问题描述

我一直在使用vba致力于Excel的电子邮件自动化，我的代码仅适用于第一封电子邮件，而下一封则出现运行时错误，

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尝试将对象设置为无，但无济于事.

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

我不知道内存泄漏在哪里

i dont know where the leak in memory is

有人可以指点我吗

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

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

模块名称=自动邮件

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

错误:

推荐答案

稍微清理了一下代码，由于不知道备注类是什么，所以无法对其进行测试. 还有其他一些看起来很奇怪的东西，自动邮件是哪种模块(类/UF/模块)? Button_Click可疑地看起来像一个用户窗体，在这种情况下，我建议阅读: https: //rubberduckvba.wordpress.com/2017/10/25/userform1-show/

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

这篇关于运行时错误，用于电子邮件自动化的VBA EXCEL的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！