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")
                .Send
            End With
            On Error GoTo 0
            Set OutMail = Nothing
            MsgBox ("Email enviado com sucesso..." & " para " & Cells(cell.Row, "B").Value)
        End If
    Next cell
limpa:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
    
End Sub