根据到期日使用 VBA 发送电子邮件

Question

我正在尝试根据我的 Excel 表上的截止日期发送电子邮件。我有一个项目列表，其中每个项目都有一个特定的所有者、该项目的描述和该项目的截止日期。

项目的收件人在“F”列，到期日期在“R”列。这是我到目前为止的代码，但我收到一条错误消息，指出存在运行时错误 13 和类型不匹配。代码运行良好一段时间，然后我开始收到此错误。当我有多个截止日期时，即发生此错误。我不确定我做错了什么。如果有任何方法可以编辑代码，请提出建议，或者如果有其他方法可以根据截止日期发送电子邮件，请告诉我代码。我将在代码中指定错误的位置。

谢谢！

  Public Sub CheckAndSendMail()
 Dim lRow        As Long
 Dim lstRow      As Long
 Dim toDate      As Date
 Dim toList      As String
 Dim ccList      As String
 Dim bccList     As String
 Dim eSubject    As String
 Dim EBody       As String
 Dim vbCrLf      As String

 Dim ws          As Worksheet

 With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False


 End With

 Set ws = Sheets(1)
 ws.Select

 lstRow = WorksheetFunction.Max(3, ws.Cells(Rows.Count, "R").End(xlUp).Row)


 For lRow = 3 To lstRow

 'THIS IS WHERE I RECEIVE THE ERROR:
    toDate = Cells(lRow, "R").Value 

    'toDate = Replace(Cells(lRow, "L"), ".", "/")
    If Left(Cells(lRow, "R"), 17) <> "Mail" And toDate - Date <= 7 Then
   vbCrLf = "<br><br>"

        toList = Cells(lRow, "F") 'gets the recipient from col F
        eSubject = "Text" & Cells(lRow, "C") & " is due on " & Cells(lRow, "R").Value
        EBody = "<HTML><BODY>"
        EBody = EBody & "Dear " & Cells(lRow, "F").Value & vbCrLf
        EBody = EBody & "Text" & Cells(lRow, "C").Value & vbCrLf
        EBody = EBody & "Text" & vbCrLf
        EBody = EBody & "Link to the Document:"
        EBody = EBody & "<A href='Link to Document'>Text </A>"
        EBody = EBody & "</BODY></HTML>"

     Cells(lRow, "W") = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column W"

        MailData msgSubject:=eSubject, msgBody:=EBody, Sendto:=toList


    End If
 Next lRow

 ActiveWorkbook.Save

 With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True

 End With

 End Sub



 Function MailData(msgSubject As String, msgBody As String, Sendto As String, _
    Optional CCto As String, Optional BCCto As String, Optional fAttach As String)

 Dim app As Object, Itm As Variant
 Set app = CreateObject("Outlook.Application")
 Set Itm = app.CreateItem(0)
 With Itm
    .Subject = msgSubject
    .To = Sendto
    If Not IsMissing(CCto) Then .Cc = CCto
    If Len(Trim(BCCto)) > 0 Then
        .Bcc = BCCto
    End If
    .HTMLBody = msgBody
    .BodyFormat = 2 '1=Plain text, 2=HTML 3=RichText -- ISSUE: this does not keep HTML formatting -- converts all text
    'On Error Resume Next
    If Len(Trim(fAttach)) > 0 Then .Attachments.Add (fAttach) ' Must be complete path'and filename if you require an attachment to be included
    'Err.Clear
    'On Error GoTo 0
    .Save           ' This property is used when you want to saves mail to the Concept folder
    .Display      ' This property is used when you want to display before sending
    '.Send         ' This property is used if you want to send without verification
End With
Set app = Nothing
Set Itm = Nothing
End Function

这是我收到的错误：

Answer 1

在分配给 toDate 之前，尝试将 R 列的值格式化为 Date。试试这行代码：

toDate = CDate(Cells(lRow, "R").Value)

另外，您是否检查过Cells(lRow, "R").Value 返回空值或空值时的数据。这也可能是错误的原因。