Public Sub EnviarEmail()

    'Referencia a tabela de emails
    Dim tabelaEmails As ListObject
    Dim mailConfig As Object
    Dim fields As Variant
    Dim msConfigURL As String

    Set tabelaEmails = Emails.ListObjects("ListaEmails")
    Set mailConfig = CreateObject("CDO.Configuration")
    msConfigURL = "http://schemas.microsoft.com/cdo/configuration"

    ' load all default configurations
    mailConfig.Load -1
    Set fields = mailConfig.fields

    'Declaracao dos objetos utilizados para enviar email pelo Outlook
    Dim olApp As Object
    Dim olMailItm As Object

    'Itera para cada linha do Data Body Range (valores da tabela, sem cabecalho)
    Dim Linha As Variant
    For Each Linha In tabelaEmails.DataBodyRange.Rows
        'Alocacao do objeto para envio do email
        Set olMailItm = CreateObject("CDO.Message")
        'Se der erro, ele vai para a proxima linha
        On Error GoTo Finaliza
        'Verifica se a linha deve ser enviada ou nao
        If Linha.Cells(1, 6).Value = "Sim" And Linha.Cells(1, 7).Value <> "Enviado" Then
            'Se for para enviar, pega os campos para montar o email
            With olMailItm
                .BCC = Linha.Cells(1, 1).Value
                .From = """Contas"" <controle.nf@superbac.com.br>"
                .Subject = Linha.Cells(1, 4).Value
'                .Attachments.Add "C:\Users\Visagio\Downloads\imagem.png", 1, 0
                .HTMLBody = .HTMLBody & "<img src='cid:imagem.png' height=240 width=180 />"
                .HTMLBody = .HTMLBody & Linha.Cells(1, 5).Value
            End With

            With fields
                'Enable SSL Authentication
                .Item(msConfigURL & "/smtpusessl") = True

                'Make SMTP authentication Enabled=true (1)
                .Item(msConfigURL & "/smtpauthenticate") = 1

                'Set the SMTP server and port Details
                'To get these details you can get on Settings Page of your Gmail Account
                .Item(msConfigURL & "/smtpserver") = "smtp.office365.com"
                .Item(msConfigURL & "/smtpserverport") = 25
                .Item(msConfigURL & "/sendusing") = 2

                'Set your credentials of your Gmail Account
                .Item(msConfigURL & "/sendusername") = "controle.nf@superbac.com.br"
                .Item(msConfigURL & "/sendpassword") = "notas@123"

                'Update the configuration fields
                .Update
            End With

            olMailItm.Configuration = mailConfig
            olMailItm.Send

            'Por fim, atualiza o status para nao enviar da proxima vez
            Linha.Cells(1, 6).Value = "Não"
            Linha.Cells(1, 7).Value = "Enviado"
        End If
Finaliza:
    Next

    'Mensagem de sucesso
    MsgBox "E-mails enviados com sucesso!"

End Sub