2023-02-28

How to send two different Outlook emails from same Excel sheet when 7 days from due date

I am trying to automatically notify my coworkers when their work is seven days away from being due. There are two tables on the same sheet (one sheet per coworker).

How can I send an email based on two different tables on the same sheet?

For example, Bill has treatment plans that will be due. He also has assessments that will be due. The treatment plans are in one table and the assessments are in another table on the same sheet (Sheet2 Bill).

I want an email sent to Bill when a treatment plan is seven days away from the due date.
I want a different email sent to Bill when an assessment is seven days away from the due date.

I am not seeing any error messages, but I am also not receiving any emails.

Client name is the B column.

This is a sample line from my table: enter image description here

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("Sheet2 (Bill)")
Set r = ws.Range("F5:F12")
Set Mail_Object = CreateObject("Outlook.Application")

For Each cell In r
    If cell.Value <= (Date + 7) And cell.Value >= (Date) Then

        Email_Subject = "Treatment plan is due soon"
        Email_Send_From = "blahblah@blahblah.blah"
        Email_Send_To = "blahblah@blahblah.blah"
        Email_Body = "This is an automated reminder that you have a treatment plan due within the next 7 days."

        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
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("Sheet2 (Bill)")
Set r = ws.Range("F19:F26")
Set Mail_Object = CreateObject("Outlook.Application")

For Each cell In r
    If cell.Value <= (Date + 7) And cell.Value >= (Date) Then

        Email_Subject = "Treatment plan is due soon"
        Email_Send_From = "blahblah@blahblah.blah"
        Email_Send_To = "blahblah@blahblah.blah"
        Email_Body = "This is an automated reminder that you have a treatment plan due within the next 7 days."

        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 With

    End If

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

End Sub



No comments:

Post a Comment