Notifications
Clear all

Sub para Enviar E-mail em um Range

3 Posts
1 Usuários
0 Reactions
834 Visualizações
(@oliveirara)
Posts: 0
New Member
Topic starter
 

Pessoal, boa tarde,

Preciso de ajuda com um código para enviar e-mail com anexo, em um range de destinatários.
Sou leigo em VBA e tentei adaptar um código que peguei no Google para tal função.

Acontece que tenho na aba "Capa" uma lista de destinatário, assunto e o caminho do arquivo a ser anexado.
Preciso que a macro faça isso para todos os destinatário que constam na lista. Seria basicamente um loop, mas não estou conseguindo fazer.

Anexei a planilha e o código é o seguinte:

Sub Send_Mail()

Dim rng As Range
Dim ultimalinha As Long
Dim msg As String
Dim OutApp As Object
Dim OutMail As Object

''Sheets("Capa").Select
''ultimalinha = Range("A1048576").End(xlUp).Row 'verifica qual a ultima celula preenchida

msg = "<font size='3' face='Calibri'>" & _
"Prezado(a), <br><br> Conforme solicitado, segue proposta <br></font>"

''For Each scel In snRG

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.TO = Sheets("Capa").Range("A2")
.BCC = ""
.Subject = Sheets("Capa").Range("B2")
.Attachments.Add = Sheets("Capa").Range("C2")
.HTMLBody = msg & "<br>" & "Atenciosamente, <br>" & .HTMLBody
.Display
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing

''Next

End Sub

Me ajudem Por favor!!!

Abs

 
Postado : 08/06/2015 12:27 pm
(@oliveirara)
Posts: 0
New Member
Topic starter
 

Pessoal, bom dia,

Fiquei fuçando e buscando no "Oráculo" e acabei conseguindo fazer esse loop e a macro está 100%.
Mas surgiu uma nova necessidade:

Preciso enviar o email com mais de um anexo. Porém ao invés de criar varios campos de anexo na planilha pensei em outra forma:

Pensei que ele poderia anexar todos os anexos que tenham o mesmo "Assunto" de e-mail.
Portanto a macro deve verificar todos os dados com o mesmo "Assunto" e concolidar todos os anexos em um unico e-mail.

Conseguem me ajudar?

Meu código atualizado ficou assim:

Sub Send_Mail()

Dim ultimalinha As Long
Dim Dest As String
Dim Assunto As String
Dim Anexo As String
Dim msg As String
Dim OutApp As Object
Dim OutMail As Object
Dim snRG2 As Range
Dim snRG3 As Range
Dim linha As Integer

Sheets("Capa").Select
ultimalinha = Range("A1048576").End(xlUp).Row 'verifica qual a ultima celula preenchida

Set snRG = Range("A10:" & "A" & ultimalinha)
Set snRG2 = Range("B10:" & "B" & ultimalinha)
Set snRG3 = Sheets("Capa").Range("C10:" & "C" & ultimalinha)

linha = 10

Anexo = Cells(linha, 3)

msg = "<font size='3' face='Calibri'>" & _
"Prezado(a), <br><br> Conforme acordado, segue FIN de notificação de débito. <br></font>"

While Cells(linha, 1) <> ""

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.TO = Cells(linha, 1)
.BCC = ""
.Subject = Cells(linha, 2)
.Attachments.Add (Anexo)
.Importance = 2
.HTMLBody = msg & "<font size='3' face='Calibri'>" & "<br>" & "Atenciosamente, <br>" & .HTMLBody
.Display
.Send
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing

linha = linha + 1

Wend
MsgBox ("E-mails enviados com Sucesso!")

End Sub

 
Postado : 10/06/2015 5:57 am
(@oliveirara)
Posts: 0
New Member
Topic starter
 

Pessoal, ninguém consegue me ajudar?

 
Postado : 18/06/2015 1:57 pm