Как использовать элементы коллекции на .body в VBA? - PullRequest
0 голосов
/ 22 октября 2019

Как вставить коллекцию содержимого в .HTMLBody сообщения электронной почты?

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

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
        If currWS.Cells(currCell.Row, 1).Text <> "" Then
        currManager.Clients.Add currClient, Key:=currClient.ClientID
        Else: End If
    Next


    Dim OutlookApp As Object
    Dim emailformatado As Object
    Dim destinatario As String
    Dim comcopia As String
    Dim assunto As String
   'Dim body_ As String
    Dim anexo As String
    Dim corpodoemail As String
    Set OutlookApp = CreateObject("Outlook.Application")

    For Each currManager In Managers
     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>" '& _
            Managers & "<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 = currManager.ManagerEmail
               '.CC = comcopia
                .Subject = assunto
                .HTMLBody = corpodoemail '& publicoalvo
                '.Attachments.Add anexo
                '.Display
            End With
            emailformatado.Send
            Next

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

End Sub

Коллекция прекрасно собирает и хранит информацию, но мне трудно преобразовать эту информацию в электронное письмо.

Как я могу превратить эту информацию вэлектронная почта?

https://drive.google.com/file/d/1jLkrWqZY9s2Kt2vy_cIMMRAd1H5iDCzg/view?usp=sharing

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...