vba - 如果今天的日期在到期日的四天内，请发送电子邮件

Question

我肯定会被视为 vba 初学者，并且我正在尝试在我的项目管理电子表格中构建一个自动电子邮件提醒，当今天的日期在截止日期的 4 天内。但我正在使用的代码不断返回运行时错误 13:类型不匹配。

我已经搜索了整个互联网的神圣大厅来寻找这个解决方案，但似乎没有什么能与我的具体问题相匹配，或者我只是在将其他帖子中的原则应用于这个特定代码时遇到了麻烦。

这是代码。

Option Explicit

Sub email()

    Dim r As Range
    Dim cell As Range

    Set r = Range("D4:D154")

    For Each cell In r

    If r.Value <= (Date + 4) And r.Value >= (Date + 0) Then

        Dim Email_Subject, Email_Send_From, Email_Send_To, _
        Email_Cc, Email_Bcc, Email_Body As String
        Dim Mail_Object, Mail_Single As Variant

        Email_Subject = ActiveCell(0, 2) & ActiveCell(0, -2) & "is due"
        Email_Send_From = "me@domain.com"
        Email_Send_To = Cells(1, 11)
        Email_Body = "This is an automated reminder to update BSA Project Manager on your project."

        On Error GoTo debugs
        Set Mail_Object = CreateObject("Outlook.Application")
        Set Mail_Single = Mail_Object.CreateItem(0)
        With Mail_Single
        .Subject = Email_Subject
        .To = Email_Send_To
        .Body = Email_Body
        .send
        End With

    End If

Next

If r.value <= (date+4) 行返回错误。我将整个代码都包含在上下文中，并且如果任何人在路过时看到我做的其他任何事情都是错误的，如果您愿意，可能会指出它。

我也尝试使用 DateDiff 并获得相同的结果。我在想也许我不应该将 Dim r 设置为 Range，或者我应该使用某种语言让 excel 知道 D 列中每个单元格中的内容是日期，以便数据类型匹配。

如果这是一个白痴问题，请原谅我。

Answer 1

稍微清理和简化这段代码 - 这里有几点需要考虑:

当一个接一个地声明变量时，您需要为每个声明的变量指定它们的类型:Dim Email_Subject As String, Dim Email_Send_From As String, etc. - 否则只声明最后一个 As String其余为 Variant s。

最佳实践是明确声明哪个 Workbook和 Worksheet您在引用 Range 时正在使用- 所以指定哪个工作表Range("D4:D154")开启。

您的 TYPE MISMATCH 错误来自尝试比较 r.Value至(Date + 4) , 而不是 cell.Value - 你正在遍历每个 cell毕竟。

而不是使用 ActiveCell在您的循环中，只需使用 cell然后 Offset引用右侧或左侧的列。

所以你修改后的代码可能看起来像这样:(未测试)

Sub email()
    Dim r As Range, cell As Range
    Dim ws As Worksheet
    Dim Mail_Object As Object, Mail_Single As Object
    Dim Email_Subject As String, Email_Send_From As String, Email_Send_To As String, _
        Email_Cc As String, Email_Bcc As String, Email_Body As String

    Set ws = ThisWorkbook.Worksheets("Sheet1") ' change to your sheet name
    Set r = ws.Range("D4:D154")
    Set Mail_Object = CreateObject("Outlook.Application")

    For Each cell In r
        If cell.Value <= (Date + 4) And cell.Value >= (Date) Then

            Email_Subject = cell.Offset(, 1).Value & cell.Offset(, -1).Value & "is due"
            Email_Send_From = "me@domain.com"
            Email_Send_To = ws.Cells(1, 11).Value
            Email_Body = "This is an automated reminder to update BSA Project Manager on your project."

            On Error GoTo debugs
            Set Mail_Single = Mail_Object.CreateItem(0)

            With Mail_Single
                .Subject = Email_Subject
                .To = Email_Send_To
                .Body = Email_Body
                .Send
            End With

        End If
    Next cell
    '... more code
End Sub