View Single Post
Old 05-04-2012, 05:04 AM
marreco marreco is offline Windows XP Office 2007
Join Date: Mar 2012
Posts: 8
marreco is on a distinguished road
Default Send emails to multiple people at once

Sub Send_EMail()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo limpa

    For Each cell In Columns("H").Cells.SpecialCells(xlCellTypeConstants)
    'verifica se o email é valido e se o cliente possui o estados A (atrasado)
        If cell.Value Like "?*@?*.?*" And LCase(Cells(cell.Row, "I").Value) = "a" Then
            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = cell.Value
                .Subject = "Aviso"
                .Body = "Caro " & Cells(cell.Row, "B").Value _
                      & vbNewLine & vbNewLine & _
                        "Entre em contato com nosso serviço de cobrança " & _
                        "para tratar assunto de seu interesse com urgência"
                'Podemos enviar um anexo
                .Attachments.Add ("c:\dados\carta.txt")
            End With
            On Error GoTo 0
            Set OutMail = Nothing
            MsgBox ("Email enviado com sucesso..." & " para " & Cells(cell.Row, "B").Value)
        End If
    Next cell
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub
I'd like to send multiple emails simultaneously without the need to use Outlook, possibly be using the Microsoft CDO library, someone would know how it could be done from the routine posted above, or otherwise the same.
Reply With Quote