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

以下是我收到的错误：

Error Message

Answer 1

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

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

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

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

1 个答案: