vba 根据特定值和截止日期发送电子邮件

Question

Hi there i currently have below code whereby it will send email every time it meets target of 16, 64 and 125 however is it possible along with dates

for example only send email if value of 16 is within 3 months, 64 if it is within 6 month and 125 over one year period.

Private Sub Worksheet_Calculate()

Dim NotSentMsg As String
Dim MyMsg As String
Dim SentMsg As String

On Error GoTo errHandler:
Sheet3.Unprotect Password:="1234"

NotSentMsg = "Not Sent"
SentMsg = "Sent"

With Me.Range("B6")
    If Not IsNumeric(.Value) Then
        MyMsg = "Not numeric"
    Else
        If .Value = 16 <= Now() - 90 Or .Value = 64 <= Now() - 190 Or .Value > 125 <= Now() - 365 Then
            MyMsg = SentMsg
            If .Offset(0, 1).Value = NotSentMsg Then
                Call Mail_Outlook_With_Signature_Html_2
                MsgBox "Email has been sent", vbInformation
            End If
        Else
            MyMsg = NotSentMsg
        End If
    End If
    Application.EnableEvents = False
    .Offset(0, 1).Value = MyMsg
    Application.EnableEvents = True
End With

Application.EnableEvents = True
Sheet3.Protect Password:="1234"
On Error GoTo 0
Exit Sub
errHandler:
MsgBox "An Error has Occurred  " & vbCrLf & _
       "The error number is:  " & Err.Number & vbCrLf & _
       Err.Description & vbCrLf & "Please Contact Admin"

End Sub

Answer 1

Hi Please see screenshot of yearly diary

enter image description here