我正在实现一个宏，检查 E 列中距离当前日期 7 天的日期。
If cell date - current date = 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 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
strMsgBody = strMsgBody & "
" & "
" & "Task: " & rngCell.Offset(0, -3).Text _
& " is due on " & rngCell.Text & "
" & "
" & "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 = strMsgBody
'test message
'MsgBox strMsg
'create the e-mail object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
With OutlookMail
.To = "[email protected]"
.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
它运行成功，除了一个问题。当没有日期满足条件时
rngCell.Value - Int(Now) = 7
仍会生成一封电子邮件，但未指定任何任务。我想编辑代码，以便在没有满足以下条件的日期时不发送电子邮件
rngCell.Value - Int(Now) = 7
我怎样才能实现这个？
答案1
创建一个布尔变量，并将其设置为错误的在循环之前并将其更改为真的只有当日期比较为真时才有效。然后，在发送电子邮件之前，检查状态变量。您可以进行以下更改：
1 - 之前环形，在线上方For Each rngCell In .Range(rngStart, rngEnd)放上线ValidDate = False。
2-If rngCell.Value - Int(Now) = 7 Then放好线后ValidDate = True。
3- 在该行之前 Set OutlookApp = CreateObject("Outlook.Application")添加以下行：If ValidDate = True Then
4- 关闭如果块放.Send End With在线后End If。