Guru do Excel e Power BI

Claudio, como nas mensagens anteriores, acredito que deve ter passado despercebido os avisos.

Todos os anexos neste fórum devem ser compactados antes de serem enviados. Por favor, envie novamente, compactado.

Leannder,

Desculpas, eu sabia da compactação dos anexosx, mas a minha tensão
em resolver esse 'pepino' eh tão grande, que me esqueci de faze-lo..

Reescrevi a macro, substitua seu código por esse abaixo:

Código: Selecionar todos

Sub EnviarEmail()
'Escrito por Laennder (gurudoexcel.com/forum)

    Dim sTO     As String   'Destinatario
    Dim sCC     As String   'Destinatário Cópia
    Dim sMEs    As String   'Mês
    Dim sNome   As String   'Nome do Cliente
    Dim dValor  As Double   'Valor Devido
    Dim i       As Integer  'Contador
    Dim Total   As Integer
    Dim Qty     As Integer
    Dim sht     As Worksheet
    
    'Defina a planilha onde estão os dados
    Set sht = Plan4
    
    sMEs = InputBox("Digite o mes referente as refeições: exemplo 'Abril/2015' ", _
                        "Mês referente", UCase(Format(Date - 1, "MMMM") & "/" & Format(Date - 1, "YYYY")))
    
    Qty = WorksheetFunction.CountA(Plan1.Columns(1))
    

    For i = 2 To Qty
        
        sNome = sht.Cells(i, 1)   'Coluna 1 (A)
        dValor = sht.Cells(i, 27) 'Coluna 27 (AA)
        sTO = sht.Cells(i, 2)     'Coluna 2 (B)
        sCC = "c.tavares@uol.com.br"
        
        If sTO <> "" And dValor > 0 Then
        
            'Enviar email
            Dim oOutlookApp     As Object
            Dim oOutlookMessage As Object
            Dim ns              As Outlook.Namespace
            Dim Folder          As Outlook.MAPIFolder
        
            'Instacia os objetos
            Set oOutlookApp = New Outlook.Application
            Set oOutlookMessage = oOutlookApp.CreateItem(olMailItem)
            Set ns = oOutlookApp.GetNamespace("MAPI")
            Set oOutlookApp = ns.GetDefaultFolder(olFolderInbox)
            
            oOutlookMessage.HTMLBody = "<p>Prezado(a) " & sNome & ", </p>" _
            & "<p>O valor total das suas refeições em " & sMEs & " foi de R$: " & Format(dValor, "#,##0.00") & "</p>" _
            & "Atenciosamente, "
            
            With oOutlookMessage
            .Subject = "Valor de Suas Refeições"
            .to = sTO
            .CC = sCC
            '.Display
            .Send
            End With
            
            oOutlookApp.Quit
            Set oOutlookApp = Nothing
            'fim do envio do email
            
            'Aumenta o contador
            Total = Total + 1
        
        End If
    
    Next i
    
    MsgBox "Processo finalizado" & Chr(13) & "Total de emails enviados: " & Total, vbInformation, "AVISO"

End Sub

Lembre-se de definir a referência a sua versão do Outlook. No VBE, clique em Ferramentas → Referências, e marque a versão que está utilizando, no meu caso foi o Outlook 15.0

Imagem

Guru do Excel e Power BI

Macro para envio de Email's a partir de uma planilha excel

Macro para envio de Email's a partir de uma planilha excel

Re: Macro para envio de Email's a partir de uma planilha exc

Macro para envio de Email's a partir de uma planilha excel