Отправлять отчеты менеджерам с помощью VBA и Outlook

Question

У меня есть список, который содержит: - клиенты;- менеджер электронной почты;- электронная почта главного менеджера;

Я пытаюсь отправить электронную почту, используя VBA и Outlook, таким образом, что каждый раз, когда цикл находит одного менеджера (я проверяю электронную почту),он посылает каждому клиенту, указанному для этого менеджера.

Если в филиале не указана электронная почта менеджера, электронная почта должна отправляться главному менеджеру (например, филиал 1236 получит одно электронное письмо). (главному менеджеру, с несколькими клиентами).

В теле письма будет предварительно отформатированный текст, а после этого список листов со списком клиентов.

У меня естьнекоторые проблемы:

а) перечислить клиентов филиала от листа до тела письма;б) переходить от следующего менеджера после первого электронного письма вместо повторения электронного письма для одного и того же менеджера каждый раз, когда цикл находит одного и того же менеджера. c) регистрация почты, отправленной в столбце J.

Это лист с некоторыми отчетами: https://drive.google.com/file/d/1Qo-DceY8exXLVR7uts3YU6cKT_OOGJ21/view?usp=sharing

Мой цикл работает несколько хорошо, но я считаю, что мне нужен другой подходчтобы достичь этого.

Private Sub CommandButton2_Click() 'envia o email com registro de log

    Dim OutlookApp As Object
    Dim emailformatado As Object
    Dim cell As Range
    Dim destinatario As String
    Dim comcopia As String
    Dim assunto As String
   'Dim body_ As String
    Dim anexo As String
    Dim corpodoemail As String
   'Dim publicoalvo As String

    Set OutlookApp = CreateObject("Outlook.Application")

   'Loop para verificar se o e-mail irá para o gerente da carteira ou para o gerente geral
    For Each cell In Sheets("publico").Range("H2:H2000").Cells

        If cell.Row <> 0 Then
            If cell.Value <> "" Then                   'Verifica se carteira possui gerente.
                destinatario = cell.Value              'Email do gerente da carteira.
            Else
                destinatario = cell.Offset(0, 1).Value 'Email do Gerente Geral.
            End If
            assunto = Sheets("CAPA").Range("F8").Value 'Assunto do e-mail, conforme CAPA.
           'publicoalvo = cell.Offset(0, 2).Value
           'body_ = Sheets("CAPA").Range("D2").Value
            corpodoemail = Sheets("CAPA").Range("F11").Value & "<br><br>" & _
            Sheets("CAPA").Range("F13").Value & "<br><br>" ' & _
            Sheets("CAPA").Range("F7").Value & "<br><br><br>"
           'comcopia = cell.Offset(0, 3).Value         'Caso necessário, adaptar para enviar email com cópia.
           'anexo = cell.Offset(0, 4).Value            'Caso necessário, adaptar para incluir anexo ao email.



           'Montagem e envio dos emails.
            Set emailformatado = OutlookApp.CreateItem(0)
            With emailformatado
                .To = destinatario
               '.CC = comcopia
                .Subject = assunto
                .HTMLBody = corpodoemail '& publicoalvo
                '.Attachments.Add anexo
                '.Display
            End With
            emailformatado.Send
            Sheets("publico").Range("J2").Value = "enviado"
        End If
    Next

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

Я почти уверен, что этот цикл бесполезен, но я не могу найти лучшего способа добиться этого.

Можете ли вы мне помочь?

Answer 1

Имейте класс менеджера, у которого есть коллекция клиентов. Создайте коллекцию экземпляров менеджера.

Manager Class
'@Folder("VBAProject")
Option Explicit

Private Type TManager
    ManagerEmail As String
    Clients As Collection
End Type
Private this As TManager


Private Sub Class_Initialize()
    Set this.Clients = New Collection
End Sub

Private Sub Class_Terminate()
    Set this.Clients = Nothing
End Sub
Public Property Get ManagerEmail() As String
    ManagerEmail = this.ManagerEmail
End Property
Public Property Let ManagerEmail(ByVal value As String)
    this.ManagerEmail = value
End Property
Public Property Get Clients() As Collection
    Set Clients = this.Clients
End Property

Client Class
'@Folder("VBAProject")
Option Explicit

Private Type TClient
    ClientID As String
End Type
Private this As TClient

Public Property Get ClientID() As String
    ClientID = this.ClientID
End Property
Public Property Let ClientID(ByVal value As String)
    this.ClientID = value
End Property

Standard Module
Option Explicit
Dim Managers As Collection
Sub PopulateManagers()
    Set Managers = New Collection
    Dim currWS As Worksheet
    Set currWS = ThisWorkbook.Worksheets("publico")
    With currWS
        Dim loopRange As Range
        Set loopRange = .Range(.Cells(2, 8), .Cells(.UsedRange.Rows.Count, 8)) 'H2 to the last used row; assuming it's the column for manager emails
    End With
    Dim currCell As Range
    For Each currCell In loopRange
        If currCell.value = vbNullString Then 'no manager; try for a head manager
            If currCell.Offset(0, 1).value = vbNullString Then 'no managers at all
                Dim currManagerEmail As String
                currManagerEmail = "NoManagerFound"
            Else
                currManagerEmail = currCell.Offset(0, 1).Text
            End If
        Else
            currManagerEmail = currCell.Text
        End If
        Dim currManager As Manager
        Set currManager = Nothing
        On Error Resume Next
            Set currManager = Managers(currManagerEmail)
        On Error GoTo 0
        If currManager Is Nothing Then
            Set currManager = New Manager
            currManager.ManagerEmail = currManagerEmail
            Managers.Add currManager, Key:=currManager.ManagerEmail
        End If
        Dim currClient As Client
        Set currClient = New Client
        currClient.ClientID = currWS.Cells(currCell.Row, 1).Text 'assumes client ID is in column 1
        currManager.Clients.Add currClient, Key:=currClient.ClientID
    Next
End Sub

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

Поскольку я использовал для настройки Usedrange.Rows.Countдо диапазона для цикла он должен был работать нормально без дополнительной проверки. Тем не менее, поскольку у меня нет ваших фактических данных, чтобы быть уверенным, вам это может понадобиться. У меня нет номеров строк, поэтому я не знаю, к чему относится строка 51. Чтобы зациклить менеджеров:

Sub LoopManagers()
    Dim currManager As Manager
    For Each currManager In Managers
        Debug.Print currManager.ManagerEmail
        Dim currClient As Client
        For Each currClient In currManager.Clients
            Debug.Print currClient.ClientID
        Next
    Next
End Sub

Вам нужно будет адаптировать то, что я предоставил, для создания ваших электронных писем. Работай над этим. Если вам нужна дополнительная помощь, опишите, что вы пробовали, и опишите, какие у вас проблемы.