Enviando e-mail em massa com anexo e imagens - Tecnologias

Tecnologias

Assuntos diversos ligados à tecnologia.

Syndication

Receive Email Updates



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

Published sexta-feira, 8 de fevereiro de 2013 2:40 by Paleo

Filed under:

Comments

# re: Enviando e-mail em massa com anexo e imagens@ quinta-feira, 14 de fevereiro de 2013 10:55

Galera, estive tendo dificuldades em como mandar para um determinado destinatario um arquivo difente. Exemplo: Para Antonio mandei uma planilha, Para Marcelo mandei um arquivo em pdf, ou seja adaptei o codigo para que ele mande um arquivo para cada destinatario com anexos diferentes.

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)

               If (.To = "Itanna Walquiria O. Couto") Then

                   .Subject = myDraftsFolder.Items.Item(lDraftItem).Subject

                   .HTMLBody = myDraftsFolder.Items.Item(lDraftItem).HTMLBody & "<img src='C:\Temp\image001.png'>"

                   .Attachments.Add "C:\Users\matias.oliveira\Desktop\7\Relatório MCN - ARACAJU.pdf"

                   .Display

                   .Send

               ElseIf (.To = "João G. de Almeida") Then

                   .Subject = myDraftsFolder.Items.Item(lDraftItem).Subject

                   .HTMLBody = myDraftsFolder.Items.Item(lDraftItem).HTMLBody & "<img src='C:\Temp\image001.png'>"

                   .Attachments.Add "C:\Users\matias.oliveira\Desktop\7\Relatório MCN - ARARAQUARA.pdf"

                   .Display

                   .Send

               ElseIf (.To = "Leandro Aparecido C da Silva") Then

                   .Subject = myDraftsFolder.Items.Item(lDraftItem).Subject

                   .HTMLBody = myDraftsFolder.Items.Item(lDraftItem).HTMLBody & "<img src='C:\Temp\image001.png'>"

                   .Attachments.Add "C:\Users\matias.oliveira\Desktop\7\Relatório MCN - BAURU.pdf"

                   .Display

                   .Send

               ElseIf (.To = "Cleide Leticia Lerner") Then

                   .Subject = myDraftsFolder.Items.Item(lDraftItem).Subject

                   .HTMLBody = myDraftsFolder.Items.Item(lDraftItem).HTMLBody & "<img src='C:\Temp\image001.png'>"

                   .Attachments.Add "C:\Users\matias.oliveira\Desktop\7\Relatório MCN - BELEM.pdf"

                   .Display

                   .Send

               ElseIf (.To = "Sumaker Tadeu Leandro de Araujo") Then

                   .Subject = myDraftsFolder.Items.Item(lDraftItem).Subject

                   .HTMLBody = myDraftsFolder.Items.Item(lDraftItem).HTMLBody & "<img src='C:\Temp\image001.png'>"

                   .Attachments.Add "C:\Users\matias.oliveira\Desktop\7\Relatório MCN - BELO HORIZONTE.pdf"

                   .Display

                   .Send

               ElseIf (.To = "Fernando Zavatini") Then

                   .Subject = myDraftsFolder.Items.Item(lDraftItem).Subject

                   .HTMLBody = myDraftsFolder.Items.Item(lDraftItem).HTMLBody & "<img src='C:\Temp\image001.png'>"

                   .Attachments.Add "C:\Users\matias.oliveira\Desktop\7\Relatório MCN - BLUMENAU.pdf"

                   .Display

                   .Send

               ElseIf (.To = "Leonardo Selos Ferreira") Then

                   .Subject = myDraftsFolder.Items.Item(lDraftItem).Subject

                   .HTMLBody = myDraftsFolder.Items.Item(lDraftItem).HTMLBody & "<img src='C:\Temp\image001.png'>"

                   .Attachments.Add "C:\Users\matias.oliveira\Desktop\7\Relatório MCN - BRASILIA.pdf"

                   .Display

                   .Send

               ElseIf (.To = "Cristiano Rogerio") Then

                   .Subject = myDraftsFolder.Items.Item(lDraftItem).Subject

                   .HTMLBody = myDraftsFolder.Items.Item(lDraftItem).HTMLBody & "<img src='C:\Temp\image001.png'>"

                   .Attachments.Add "C:\Users\matias.oliveira\Desktop\7\Relatório MCN - CAMPINAS II.pdf"

                   .Display

                   .Send

               ElseIf (.To = "Jose Roberto da Rocha Gamero") Then

                   .Subject = myDraftsFolder.Items.Item(lDraftItem).Subject

                   .HTMLBody = myDraftsFolder.Items.Item(lDraftItem).HTMLBody & "<img src='C:\Temp\image001.png'>"

                   .Attachments.Add "C:\Users\matias.oliveira\Desktop\7\Relatório MCN - CAMPINAS.pdf"

                   .Display

                   .Send

               ElseIf (.To = "Thiago L. Bechelany") Then

                   .Subject = myDraftsFolder.Items.Item(lDraftItem).Subject

                   .HTMLBody = myDraftsFolder.Items.Item(lDraftItem).HTMLBody & "<img src='C:\Temp\image001.png'>"

                   .Attachments.Add "C:\Users\matias.oliveira\Desktop\7\Relatório MCN - CAMPO GRANDE.pdf"

                   .Display

                   .Send

End If

           End With

       Next

   Next lDraftItem

   Set myDraftsFolder = Nothing

   Set myNameSpace = Nothing

   Set myOutlook = Nothing

End Sub

Desde já agradeço o comentario do professor.

Matias

# re: Enviando e-mail em massa com anexo e imagens@ quinta-feira, 14 de fevereiro de 2013 11:46

Matias,

legal, mas dessa forma não tem vantagem alguma entre enviar manualmente, pois tivestes que inserir o nome de cada um no código.

O melhor seria disparares a macro de uma planilha Excel, onde na primeira coluna tivesse o nome do destinatário e na segunda o anexo a ser enviado para ele, desta forma ficaria automático.

Se desejar eu posso criar este código para Excel e depois postar aqui.

Paleo

# re: Enviando e-mail em massa com anexo e imagens@ quarta-feira, 3 de abril de 2013 23:15

Carlos estou usando o outlook 2013 fiz o teste do script para envio de anexo e imagens. Abri o email do Hotmail ao qual enviei o email, la consta recebido e o ícone do clip (anexo), so que não consigo ver os anexos. Sera que fiz alguma coisa errada. Tenho outros e-mails com o símbolo do clips e mostra os anexos.

Atenciosamente

Vanilson

Vanilson

# re: Enviando e-mail em massa com anexo e imagens@ terça-feira, 9 de abril de 2013 10:57

Professor, muito boa a dica...trabalho com associados e poder enviar manualmente é excelente. Só não consegui resolver um problema, o arquivo em jpg quando tento anexar fica destorvido, o que ocorre?

Wilson Souza

# re: Enviando e-mail em massa com anexo e imagens@ sexta-feira, 19 de abril de 2013 16:07

Vanilson, só pode ser bloqueio do Hotmail. Ele faz isso quando não julga o remetente confiável. Por favor, verifique se não há uma opção de desbloquear o conteúdo do remetente ou de torna-lo confiável.

Paleo

# re: Enviando e-mail em massa com anexo e imagens@ segunda-feira, 27 de maio de 2013 21:01

Caro amigo Carlos. Obrigado pela sua atenção. Pois é, não dá erro algum apenas não envia a imagem anexada no corpo do email ( no meu caso : teste.jpg ) as outras duas imagens que estão como anexo, teste1.jpg e teste2.jpg envia corretamente.

O script que estou usando é esse:

Private Declare Sub AppEspera Lib "kernel32" Alias "Sleep" (ByVal dwMilliseconds As Long)

Public Sub Pausa(PausaEmSegundos As Long)

Call AppEspera(PausaEmSegundos * 1000)

End Sub

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:\Imagem Email teste\teste.jpg'>"

               .Attachments.Add "C:\Imagem Email Teste\teste1.jpg"

               .Attachments.Add "C:\Imagem Email Teste\teste2.jpg"

               .Display

               .Send

           End With

           Pausa 3

       Next

   Next lDraftItem

   Set myDraftsFolder = Nothing

   Set myNameSpace = Nothing

   Set myOutlook = Nothing

End Sub

Muito grato.

Abraços.............

Junio Borotto

# re: Enviando e-mail em massa com anexo e imagens@ quarta-feira, 21 de agosto de 2013 11:47

Bom dia!

Sou muito leigo no assunto Informática, mas acredito conseguir executar suas lições.

Gostaria de fazer uma pergunta, esse mesmo código funciona pra um envio grande de 30 mil emails?

Obrigado pela atenção.

César Dias

# re: Enviando e-mail em massa com anexo e imagens@ quarta-feira, 21 de agosto de 2013 11:55

César,

o script em si suporta, mas dificilmente o teu provedor suportará. Vai identificar como spam e bloquear o envio.

Paleo

Leave a Comment

(required) 
(required) 
(optional)
(required)