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