Este fórum está sendo desativado

[laennder]

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.

[ClaudioTavares]

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..

[laennder]

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