問題描述
運行時錯誤，用於電子郵件自動化的 VBA EXCEL (Runtime Error, VBA EXCEL for email automation)
我一直在使用 vba 為 excel 進行電子郵件自動化，我的代碼僅適用於第一封電子郵件，並且在下一封電子郵件中出現運行時錯誤，
我嘗試將對象設置為無濟於事，但無濟於事..
我不知道內存洩漏在哪裡
有人能指出我嗎
錯誤在對象備註處。我提供了錯誤的屏幕截圖。
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
錯誤：
參考解法
方法 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