Enviando e-mail em massa com anexo e imagens
Tenho recebido dúvidas se seria possível enviar anexos também com o meu script. Parece que muita gente gostaria disso…
Pois é, a melhor parte é que além de ser possível, é mega simples! Basta adicionar uma única linha. Veja ela em destaque:
Public Sub SepareDrafts()
Dim lDraftItem As Long
Dim myOutlook As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolders As Outlook.Folders
Dim myDraftsFolder As Outlook.MAPIFolder
Dim objMailMessage As Outlook.MailItem
Dim emlBody, sendTo As String
Dim TOs
Set myOutlook = Outlook.Application
Set myNameSpace = myOutlook.GetNamespace("MAPI")
Set myFolders = myNameSpace.Folders
Set myDraftsFolder = myNameSpace.PickFolder
For lDraftItem = myDraftsFolder.Items.Count To 1 Step -1
TOs = Split(myDraftsFolder.Items.Item(lDraftItem).To, ";")
For i = 0 To UBound(TOs)
Set objMailMessage = myOutlook.CreateItem(olMailItem)
With objMailMessage
.BodyFormat = olFormatHTML
.To = TOs(i)
.Subject = myDraftsFolder.Items.Item(lDraftItem).Subject
.HTMLBody = myDraftsFolder.Items.Item(lDraftItem).HTMLBody & "<img src='C:\Temp\image001.png'>"
.Attachments.Add "C:\Temp\faturamento.xlsx"
.Display
.Send
End With
Next
Next lDraftItem
Set myDraftsFolder = Nothing
Set myNameSpace = Nothing
Set myOutlook = Nothing
End Sub
Para entender todo o script não deixe de ler os posts anteriores!
Enviando individualmente e-mails em massa, com imagem no corpo do e-mail
Enviando individualmente e-mails em massa