用于多个匹配单元格检测的宏

Question

我正在实施一个宏，用于检查 E 列中距离当前日期 7 天的日期。

如果单元格日期 - 当前日期 = 7

然后发送一封电子邮件，其中包含具有匹配单元格的行。这是我的代码，除了一个问题外，它运行成功。

Sub Workbook_Open()

Dim rngStart As Range
Dim rngEnd As Range
Dim rngCell As Range
Dim strHtmlHead As String
Dim strHtmlFoot As String
Dim strMsgBody As String
Dim strMsgBody1 As String
Dim strMsg As String
Dim objEmail As Object
Dim OutlookApp As Object
Dim OutlookMail As Object

'On Error GoTo ErrHnd

'only run if between midnight and 2AM
'If Hour(Now) < 2 Then

'setup basic HTML message header and footer


'setup start of body of message
strMsgBody = "The following task(s) are due in less than 7 days :"

'Worksheet name
With Worksheets("Sheet1")
    'set start of date range
    Set rngStart = .Range("E1")
    'find end of date range
    Set rngEnd = .Range("E" & CStr(Application.Rows.Count)).End(xlUp)

    'loop through all used cells in column G
    For Each rngCell In .Range(rngStart, rngEnd)
        'test if date is equal to 7 days from today
        If IsDate(rngCell.Value) Then
        If rngCell.Value - Int(Now) = 7 Then
            'add to message - use task name from column A (offset -3)
            'change as required
            strMsgBody1 = strMsgBody & "<Br>" & "<Br>" & "Task: " & rngCell.Offset(0, -3).Text _
                & " is due on  " & rngCell.Text & "<Br> " & "<Br> " & "Therefore please take necessary action"
        End If
        End If
    Next rngCell

    'Note last test time/date
    rngEnd.Offset(1, -3) = Now
    rngEnd.Offset(1, -3).NumberFormat = "dd/mm/yy"
End With

'put message together
strMsg = strMsgBody1

'test message
'MsgBox strMsg

'create the e-mail object


Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)

With OutlookMail

.To = "adrianadriananthony@outlook.com"
.CC = ""
.BCC = ""
.Subject = "Task Alert"
.HTMLBody = strMsg
.Send
End With


Set OutlookMail = Nothing
Set OutlookApp = Nothing

Application.DisplayAlerts = True
Application.ScreenUpdating = True


'remove the e-mail object

Exit Sub

'error handler
ErrHnd:
Err.Clear

End Sub

当有两条或多条记录的日期相同且符合条件时

单元格日期 - 当前日期 = 7

那么邮件中只会显示一条记录，并发送到该邮箱地址。

例如有3条记录如下：

并且仅检测到第三条记录并将其附加到电子邮件正文。

我想知道为什么会这样？ 我如何编辑我的代码来纠正这个问题？

Answer 1

要解决此问题，请删除 strMsgBody1 声明并将每个匹配项替换为 strMsgBody。你不需要第二个变量。

用于多个匹配单元格检测的宏

Macro for multiple matching cells detection

excel

outlook

vba