AJUDA! Envio de e-mail em massa (Gmail) via VBA - Acumulando anexos

[rpaustoni]

Oooi!

Por favor, alguém consegue me ajudar com esse problema.

O código para envio de e-mail em massa via VBA/Gmail está funcionando certinho.

Quando adiciono um anexo fixo para todos os destinatários também dá tudo certo.

Ao tentar adicionar um anexo personalizado para cada destinatário ele começa a acumular os anexos. 

Exemplo: Destinatário A = envio com anexo A

Destinatário B = envio com anexo A e B

Destinatátio C = envio com anexo A, B e C 

(...)

A planilha está da seguinte forma:

Coluna A: endereço de e-mails

Coluna B: nome

 

Segue o código:

 

Sub EnviarEmail()

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1    ' CDO Source Defaults
Set Flds = iConf.Fields

    With Flds
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "meuemail"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "senha"
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
    .Update
    End With

For linha = 2 To 5

    With iMsg
        Set .Configuration = iConf
        
        ' Destinatários:
        .To = Cells(linha, 1).Value
        
        ' Com cópia para:
        .BCC = "meuemail"
        .CC = ""
                      
        ' De:
        .From = "meuemail"
        
        ' Assunto do e-mail
        .Subject = "Renovação Convênio - 2022/2"
        
        ' Texto do e-mail
        .HTMLBOdy = "<b><p style=color:blue;>O PRAZO PARA RENOVAÇÃO DO DESCONTO CONVÊNIO PARA <u>2022/2</u> ESTÁ ABERTO!</b></p><br>" _
        & "<b><u>ATENÇÃO</u>: Os prazos estabelecidos abaixo devem ser seguidos impreterivelmente, a fim de evitarmos quaisquer transtornos com o aluno e impactos nos processos internos necessários para a concessão do benefício.</b><br><br>Confira abaixo as datas para envio e regras para concessão nas <b>MENSALIDADES</b>:<br><br>- PRAZO PARA RENOVAÇÃO E INSERÇÃO DE NOVOS ALUNOS (AS):<br><br><u>Presencial 2022/2</u><br>Prazo Final 15/07/22: para incidir a partir da mensalidade de Agosto.<br>Prazo Final 15/08/22: para incidir a partir da mensalidade de Setembro.<br>Prazo Final 15/09/22: para incidir a partir da mensalidade de Outubro.<br><br><u>EaD 2022.3</u><br>Prazo Final 15/07/22: para incidir a partir da mensalidade Agosto.<br>Prazo Final 15/08/22: para incidir a partir da mensalidade Setembro.<br><br><u>EaD 2022.4</u><br>Prazo Final 15/09/22: para incidir a partir da mensalidade Outubro.<br>" _
        & "Prazo Final 15/10/22 - para incidir a partir da mensalidade Novembro.<br><br><br>Em anexo enviamos uma planilha com as informações dos alunos que tiveram o benefício no 1º semestre de 2022, pedimos a gentileza que validem e sinalizem se terão a renovação ou se deverá ser cancelado.<br><br><b>No caso de existir inclusão de novos nomes, gentileza acrescentar na planilha, preenchendo todos os campos solicitados.</b><br><br>*Material para divulgação em anexo.<br>" _
        & "<br><br>At.te,<br><br>"
        
        ' Anexos personalizados
        .AddAttachment ThisWorkbook.Path & "\CONVÊNIO - " & Cells(linha, 2).Value & ".xls"
                  
        ' Anexos fixos
        .AddAttachment ThisWorkbook.Path & "\Divulgação - Mensalidades.jpg"
                  
        .Send
        
    End With
Next
    

MsgBox "E-mails Enviados"
End Sub