Как вставить коллекцию содержимого в .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