Хотите отправить 1 напоминание по электронной почте каждому сотруднику, в котором указаны имена и телефоны клиентов, ТОЛЬКО если дата обратного вызова клиента сегодня

Question

Staff_Name   Client_FName   Client_LName   Client_Phone  Call_Back_Date  Staff_Email

Из Excel я хочу отправить 1 напоминание по электронной почте каждому сотруднику, в котором указаны имена и номера телефонов их клиентов, ТОЛЬКО если сегодня клиент перезвонил.

Я смоготправить сотрудникам напоминание по электронной почте, чтобы позвонить своим клиентам, которые должны перезвонить сегодня. Я выяснил, как это сделать для каждого клиента, но если сегодня у сотрудников 10 клиентов, которым необходимо перезвонить, я не хочу, чтобы они получали 10 писем. Я хочу составить список и отправить только 1 электронное письмо сотрудникам со всеми их именами клиентов и номерами телефонов в ОДНОМ электронном письме сотрудникам.

Sub CallReminder1()
Dim OutlookApp As Object
Dim objMail As Object
Dim nextcalldate As Date
Dim datetoday As Date
Dim x As Long

For x = 2 To WorksheetFunction.CountA(Columns(2))

    nextcalldate = Cells(x, 5).Value
    datetoday = Date

    If nextcalldate <= datetoday Then
        Set OutlookApp = CreateObject("Outlook.Application")
        Set objMail = OutlookApp.CreateItem(olMailItem)
        objMail.To = Cells(x, 6).Value

        With objMail
            .Subject = "Calls to make Today"
            .Body = Cells(x, 1) & ": " & Cells(x, 2) & " " & Cells(x, 3) & ", " & Cells(x, 4)
            .Send
        End With
    End If
Next

Set OutlookApp = Nothing
Set objMail = Nothing
End Sub

Он отправляет отдельные электронные письма. Мне нужно, чтобы все обратные вызовы были собраны в 1 письмо для каждого сотрудника.

Answer 1

Вы можете использовать словарь объекта, набираемый на фамилии сотрудника. Зацикливайтесь на данных и собирайте звонки для каждого человека, затем зацикливайте ключи словаря и создавайте письма.

Sub CallReminder1()

    Const olMailItem As Long = 0
    Dim OutlookApp As Object
    Dim objMail As Object
    Dim nextcalldate As Date
    Dim staff As String, msg As String
    Dim dict As Object
    Dim x As Long, k

    Set dict = CreateObject("scripting.dictionary")

    'collect all of the due calls, arranged by staff name
    For x = 2 To WorksheetFunction.CountA(Columns(2))
        nextcalldate = Cells(x, 5).Value
        If nextcalldate <= Date Then
            staff = Cells(x, 6).Value
            msg = Cells(x, 1) & ": " & Cells(x, 2) & " " & _
                Cells(x, 3) & ", " & Cells(x, 4) & vbCrLf
            'add to any existing message for this staff member
            If dict.Exists(staff) Then
                dict(staff) = dict(staff) & msg
            Else
                dict(staff) = msg
            End If
        End If
    Next

    Set OutlookApp = CreateObject("Outlook.Application")

    'loop over the dictionary keys (staff)
    '  and create a mail per staff
    For Each k In dict.keys
        Set objMail = OutlookApp.CreateItem(olMailItem)
        objMail.To = NameToEmail(k) '<<< EDIT
        With objMail
            .Subject = "Calls to make Today"
            .Body = dict(k)
            .Send
        End With
    Next k

    Set OutlookApp = Nothing
    Set objMail = Nothing
End Sub

Function NameToEmail(staffName)
    Dim m
    m = Application.VLookup(staffName, _
        ThisWorkbook.Sheets("StaffEmails").Range("A2:B1000"), 2, False)
    NameToEmail = IIf(IsError(m), "???", m) 'return "???" if no match
End Function