Envio de múltiplos e-mails com diferentes anexos, porém cada e-mail com um anexo único.

Question

Bom, estava trabalhando em um código e travei no seguinte detalhe:

Preciso enviar cerca de 30 e-mails, com 30 diferentes anexos, um para cada e-mail. Esses anexos são gerados de uma mesma base, através de uma outra macro distinta. O objetivo é somente a divulgação dos resultados de cada estabelecimento.

O que eu possuo ate agora :

Sub Envia_Emails(EnviarPara As String, MensagemUM As String, MensagemDOIS As String, MensagemTRES As String, MensagemQUATRO As String, Assunto As String, Assinatura As String, Anexo As String)
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
    With OutlookMail
        .To = EnviarPara
        .CC = ""
        .BCC = ""
        .Subject = Assunto
        .HTMLBody = MensagemUM & "<br><br>" & _
            MensagemDOIS & "<br><br>" & _
            MensagemTRES & "<br><br>" & _
            MensagemQUATRO & "<br><br>" & _
            "<br><br>" & _
            Assinatura & _
            "</font>" & "<br>" & .HTMLBody
        .Attachments.Add "C:\Users\MIGUEL.AMERICANO\Desktop\Auxiliar\BAHIA.xlsx"

O que eu preciso é que o código .Attachments.Add funcione junto com o for, para buscar os arquivos de cada estabelecimento, localizados na pasta "Auxiliar". 

Cada e-mail é direcionado a um estabelecimento e este tem seu devido anexo, ou seja, não posso mandar um anexo único para todos.

Alguém por favor me ajude?

Answer 1

for arquivo = 1 to 30

call Envia_Emails(EnviarPara , MensagemUM , MensagemDOIS , MensagemTRES , MensagemQUATRO , Assunto , Assinatura , Anexo , arquivo )

next arquivo

Sub Envia_Emails(EnviarPara As String, MensagemUM As String, MensagemDOIS As String, MensagemTRES As String, MensagemQUATRO As String, Assunto As String, Assinatura As String, Anexo As String, arquivo as string)
    Dim OutlookApp As Object
    Dim OutlookMail As Object
    Set OutlookApp = CreateObject("Outlook.Application")
    Set OutlookMail = OutlookApp.CreateItem(0)
    With OutlookMail
        .To = EnviarPara
        .CC = ""
        .BCC = ""
        .Subject = Assunto
        .HTMLBody = MensagemUM & "<br><br>" & _
            MensagemDOIS & "<br><br>" & _
            MensagemTRES & "<br><br>" & _
            MensagemQUATRO & "<br><br>" & _
            "<br><br>" & _
            Assinatura & _
            "</font>" & "<br>" & .HTMLBody
        .Attachments.Add "C:\Users\MIGUEL.AMERICANO\Desktop\Auxiliar\" & arquivo" & ".xlsx"

.send

end with

end sub

---

A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz [e-mail]