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

时间:2018-08-03 18:01:15

标签: excel vba excel-vba

我绝对会被视为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列中每个单元格中的内容都是日期,以便数据类型匹配。

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

1 个答案:

答案 0 :(得分:0)

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

  • 在一个接一个地声明变量时,需要为每个声明的变量指定其类型:Dim Email_Subject As String, Dim Email_Send_From As String, etc.-否则,只有最后一个声明为As String,其余为Variant
  • 最佳做法是在引用Workbook时显式声明要使用的WorksheetRange-因此,请指定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