VBA Email Reminder from Excel

[CassieL]

Hi everyone,

I have dateline in date format in cell C13, and the following is my codes. How can I auto send a reminder email 3 days prior to the dateline in C13?

Thanks,

 Dim OutApp As Object    Dim OutMail As Object
    Dim strbody As String
    Dim sTO As String, sSubj As String, sCC As String
    
    sCC = Range("C9")
    sTO = Range("C32")
    sSubj = Range("C3")
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    strbody = " Hi there, " & vbNewLine & vbNewLine & _
    "You have received a PO Trouble Ticket - " & Range("C3") & vbNewLine & _
    "Please visit https://extranet.jll.com/sites/HSBC/Services/afs/Working%20Documents/Forms/AllItems.aspx?RootFolder=%2Fsites%2FHSBC%2FServices%2Fafs%2FWorking%20Documents%2FPO%20Issue%20Tracker&FolderCTID=0x012000486DB623C21B3C49888E334CB16B75B5&View=%7B1CE984E7%2D73AA%2D419E%2D90AD%2DDE14E1B702F6%7D to resolve the issue." & vbNewLine & _
    "Please add your conmmentary in the {Resolution} section." & vbNewLine & vbNewLine & _
    "Thanks" & vbNewLine & _
    Range("C8")
    
    
     On Error Resume Next
    With OutMail
        .To = sTO
        .CC = ""
        .BCC = ""
        .Subject = "[IMPORTANT] " & sSubj
        .Body = strbody
        .send
End With
debugs:
If Err.Description <> "" Then MsgBox Err.Description
End Sub

 

[yky]

Name the code you posted SendReminder. Create another module with the following code:

Sub test()

If DateDiff("d", Now, Range("C13").Value) = 3 And Len(Range("D13")) = 0 Then

SendReminder

Range("D13").Value = "Reminder sent on " & Now
End If

End Sub

This code checks whether the date in C13 is three days apart from Now. If yes and if D13 is empty, it calls SendReminber to send a reminder and store the date and time the reminder is sent in D13 which you can change at will. If D13 is not empty, no reminder will be sent (you don't want to over-remind people).

 

[CassieL]

Hi Thanks for replying,

What about to check whether the date in C13 is three days apart from now and if G16 is false, then "Send Reminder". How can I corporate the codes above you had into the following codes?:

Thanks!

Dim OutApp As Object    
    Dim OutMail As Object
    Dim strbody As String
    Dim sTO As String, sSubj As String
    
    If Not Range("G16") Then
    Range("G16").Parent.Tab.Color = vbRed
Else
    Range("G16").Parent.Tab.Color = vbGreen
End If


    sTO = Range("C32")
    sSubj = Range("C3")
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    strbody = " Hi there, " & vbNewLine & vbNewLine & _
    "Thank you for resolving Trouble Ticket - " & Range("C3") & vbNewLine & vbNewLine & _
    "Thanks" & vbNewLine & _
    Range("C8")
    
    
     On Error Resume Next
    With OutMail
        .To = sTO
        .CC = ""
        .BCC = ""
        .Subject = "[CLOSED] " & sSubj
        .Body = strbody
        .send
    
End With
debugs:
If Err.Description <> "" Then MsgBox Err.Description


End Sub

 

[yky]

Maybe this?

[COLOR=#333333]Dim OutApp As Object    [/COLOR]    
Dim OutMail As Object
    Dim strbody As String
    Dim sTO As String, sSubj As String
    
    [COLOR=#0000cd]If  DateDiff("d", Now, Range("C13").Value) = 3 and Not Range("G16") Then
    Range("G16").Parent.Tab.Color = vbRed[/COLOR]



    sTO = Range("C32")
    sSubj = Range("C3")
    
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    
    strbody = " Hi there, " & vbNewLine & vbNewLine & _
    "Thank you for resolving Trouble Ticket - " & Range("C3") & vbNewLine & vbNewLine & _
    "Thanks" & vbNewLine & _
    Range("C8")
    
    
     On Error Resume Next
    With OutMail
        .To = sTO
        .CC = ""
        .BCC = ""
        .Subject = "[CLOSED] " & sSubj
        .Body = strbody
        .send
    
End With

[COLOR=#0000cd]Else
    Range("G16").Parent.Tab.Color = vbGreen
End If[/COLOR]

debugs:
If Err.Description <> "" Then MsgBox Err.Description

 [COLOR=#333333]End Sub[/COLOR]