0

I am trying to create a macro where the all pending tasks for one person, one e-mail, will be included in one Outlook e-mail. Basically the program will search for the pending tasks, group them all and send it to the e-mail address of the person it is assigned to.

I was able to modify/create a code where the pending task reminders are sent automatically, but it is sending one task per e-mail. This floods the person with multiple reminders.

Is it possible to have one e-mail reminder that includes all the pending tasks for that person?

Sub Reminder()
    Dim wStat As Range, i As Long
    Dim dam As Object
    
    For Each wStat In Range("D6", Range("D" & Rows.Count).End(xlUp))
        If wStat.Value = "Pending" Then
            i = wStat.Row
            If Cells(i, "I").Value <= Range("I3").Value Then
                Set dam = CreateObject("Outlook.Application").CreateItem(0)
                dam.To = Range("L" & i).Value
                dam.CC = Range("L" & i).Value
                dam.Subject = Range("B" & i).Value
                dam.Body = "Dear " & Range("E" & i).Value & "," & vbCr & vbCr & _
                    "This is to remind you that the task: " & Range("B" & wStat.Row).Value & " - " & " " & _
                    "is still pending." & vbCr & vbCr & _
                    "Thank you!"
                '
                dam.Send 'change send to display if you want to check
                wStat.Value = "Pending"
           End If
        End If
    Next

    MsgBox "Reminders Sent!"
End Sub

This is the sample Excel file
This is the sample excel file

This is what it looks like now
This is what it looks like now

This is what I want it to look like
This one here is what I want it to look like

Community
  • 1
  • 1
  • My suggestion: Sort data by email address. Loop throught data row wise, collect tasks until email address changes and send email for those, then start collecting new tasks for the next email address until it changes. This way you have only one loop through your data if it is sorted. – Pᴇʜ Apr 19 '21 at 07:28
  • Hi, thanks for the suggestion! Thing is I'm honestly having trouble visualizing it into a code... could you please provide any sample code for the sort by email and collect tasks? That's the part confusing me actually.. – CheeseBurger555 Apr 20 '21 at 01:25
  • Everytime you have no glance how to start with a code just use the Macro Recorder and do it manually. This way you get an idea how the code could look like. Note that recorded code has a lot of `.Select` statements and needs to be refined ([How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba)) to work reliable. • So I suggest you record a macro, do the sort manually (use the functions in the Data ribbon) and try to use what you learn from that code. If you then get stuck or errors come back showing what you have tried. – Pᴇʜ Apr 20 '21 at 05:52
  • Hi! Okay I tried doing it again and I think I'm almost there. (I think....) what I tried was I used filter for each assigned person as well as "pending" tasks. The code also works with what is shown in the visible cells only. Now my problem is.... I don't know how to group all the "pending task names" into one outlook e-mail body so that it will only send once to the email of the assigned person... help please? :) the code is still creating separate e-mails and subjects/body when I only need it to show the visible ones that I filtered.... – CheeseBurger555 Apr 20 '21 at 13:39

1 Answers1

0

Based on the image of the file, to create only one email

Option Explicit

Sub Reminder()

    Dim wks As Worksheet
    Set wks = ActiveSheet
    
    Dim LastRow As Long
    Dim taskStr As String
    
    Dim olApp As Object
    Dim dam As Object
    
    Set olApp = CreateObject("Outlook.Application")
    Set dam = olApp.CreateItem(0)
    
    dam.To = wks.Range("B2").Value
    dam.Subject = "Pending Tasks"
    
    LastRow = wks.Cells(wks.Rows.count, "A").End(xlUp).Row
    Debug.Print "LastRow: " & LastRow
    
    For i = 2 To LastRow
        taskStr = taskStr & wks.Range("A" & i).Value & vbCr
        Debug.Print taskStr
    Next
    
    dam.body = "Dear " & wks.Range("C2").Value & "," & vbCr & vbCr & _
                "The tasks below are still pending: " & vbCr & vbCr & taskStr
                
    dam.Display
    
End Sub
niton
  • 8,771
  • 21
  • 32
  • 52