Gerar lista de E-mails numa Planilhas

Question

Pessoal,

Preciso extrair informações do Outlook para Excel, a principio encontrei o código VBA abaixo criado pelo colega Felipe Gualberto que é praticamente o que preciso. No entanto, o código abaixo exporta todos os e-mails do Outlook.

No meu caso, preciso exatamente do código abaixo, porém, de modo que ele exporte apenas os e-mails de uma pasta especifica no Outlook.

EX: Caixa de Entrada/Vendas, ou seja, exporte apenas os e-mails que esteja na pasta "Vendas".

Por gentileza, alguém poderia me ajudar adaptando o código abaixo para minha necessidade?
Desde já agradeço a todos!

Dim r As Long

Sub GerarLista()

    Dim appOutlook As Outlook.Application
    Dim olNS As Outlook.Namespace
    Dim olFolder As Outlook.Folder
    
    On Error Resume Next
    Set appOutlook = GetObject(, "Outlook.Application")
    If appOutlook Is Nothing Then 'ou seja, se não há instância, deve-se criar uma.
        Set appOutlook = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    
    Set olNS = appOutlook.GetNamespace("MAPI")
    'Troque a constante abaixo se desejar que se faça varredura em outra pasta.
    Set olFolder = olNS.GetDefaultFolder(olFolderInbox)
    
    'Limpa Planilha
    Cells.Delete
    r = 0
    DescePasta olFolder
    
    Set olFolder = Nothing
    Set olNS = Nothing
    
End Sub

Sub DescePasta(olFolder As Outlook.Folder)
    
    Dim olSubFolder As Outlook.Folder
    'Agora será necessário declarar um objeto do tipo arquivo
    'para realizar um loop de leitura de arquivos numa pasta
    Dim olItem As MailItem
    
    r = r + 1
    Cells(r, "A") = olFolder.FolderPath
    For Each olItem In olFolder.Items
        r = r + 1
        'Você pode visualizar uma série de propriedades de um objeto MailItem. Exemplos:
        Cells(r, "A") = olItem.Subject 'Assunto do e-mail
        Cells(r, "B") = olItem.SenderEmailAddress 'E-mail do remetente
        Cells(r, "C") = olItem.To 'E-mail do destinatário
        Cells(r, "D") = olItem.ReceivedTime 'Data/Hora de recebimento
        Cells(r, "E") = olItem.Attachments.Count 'Número de anexos
        Cells(r, "F") = olItem.Size 'Tamanho da mensagem em bytes
    Next olItem
    
    For Each olSubFolder In olFolder.Folders
        DescePasta olSubFolder
    Next olSubFolder
    
End Sub

Answer 1

Ao inserir um código no fórum, utilize blocos de código. Para utilizar essa ferramenta, clique no botão cuja legenda é “Inserir bloco de código” na barra do editor de mensagens do fórum.

---

Sobre sua dúvida, faça algo como mostrado abaixo:

Sub GerarLista()

    Dim appOutlook As Outlook.Application
    Dim olNS As Outlook.Namespace
    Dim olFolder As Outlook.folder
    Dim r As Long
    Dim olItem As MailItem
    
    On Error Resume Next
    Set appOutlook = GetObject(, "Outlook.Application")
    If appOutlook Is Nothing Then 'ou seja, se não há instância, deve-se criar uma.
        Set appOutlook = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    
    Set olNS = appOutlook.GetNamespace("MAPI")
    'Troque a constante abaixo se desejar que se faça varredura em outra pasta.
    Set olFolder = olNS.Folders("[e-mail]").Folders("Caixa de entrada").Folders("Vendas")
    
    'Limpa Planilha
    Cells.Delete
    
    r = r + 1
    Cells(r, "A") = olFolder.FolderPath
    For Each olItem In olFolder.Items
        r = r + 1
        'Você pode visualizar uma série de propriedades de um objeto MailItem. Exemplos:
        Cells(r, "A") = olItem.Subject 'Assunto do e-mail
        Cells(r, "B") = olItem.SenderEmailAddress 'E-mail do remetente
        Cells(r, "C") = olItem.To 'E-mail do destinatário
        Cells(r, "D") = olItem.ReceivedTime 'Data/Hora de recebimento
        Cells(r, "E") = olItem.Attachments.Count 'Número de anexos
        Cells(r, "F") = olItem.Size 'Tamanho da mensagem em bytes
    Next olItem
End Sub

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 2

Muito Obrigado Felipe!

Ficou exatamente o que eu precisava!

Answer 3

Olá Felipe,

Ontem executei o código em meu notebook com meu e-mail linkado no Outlook e funcionou corretamente.

Hoje estou tentando executar no notebook da empresa, alterei o endereço de e-mail (para o da empresa) e a pasta conforme necessidade, porém, não está funcionando.

Mensagem de erro: Run Time ' -2147221233(8004010f):  Automation Error

Você poderia me ajudar?

Answer 4

Em qual linha você obtém esse erro?

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br

Answer 5

A macro não indica a linha, simplesmente ao alterar a informação (e-mail e pasta) ela não executa.

Existe a possibilidade de ser alguma segurança do servidor da empresa?

Acho estranho pois, no código onde todos os e-mails sem critério são extraídos sem problema.

Answer 6

Não sei o que pode ser. Em todo caso,m experimente executar a macro com o Outlook já aberto.

---

Felipe Costa Gualberto - http://www.ambienteoffice.com.br