时间戳

首页 > 解决方案 > 发送一封电子邮件，其中包含该人的所有待处理主题

excel - 发送一封电子邮件，其中包含该人的所有待处理主题

问题描述

我正在尝试创建一个宏，其中一个人的所有待处理任务，一封电子邮件，将包含在一封 Outlook 电子邮件中。基本上，该程序将搜索待处理的任务，将它们全部分组并将其发送到分配给它的人的电子邮件地址。

我能够修改/创建自动发送待处理任务提醒的代码，但它每封电子邮件发送一个任务。这会用多个提醒淹没这个人。

是否可以有一封电子邮件提醒，其中包括该人的所有待处理任务？

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

这是示例 Excel 文件
这是示例 excel 文件

这是现在的样子
这是现在的样子

这就是我想要的样子
这个是我想要的样子

标签： excelvbaoutlook

解决方案

基于文件的图像，只创建一封电子邮件

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

推荐阅读