none
Gerar lista de E-mails numa Planilhas RRS feed

  • Pergunta

  • 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

    quarta-feira, 9 de outubro de 2013 00:35

Respostas

  • 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("seu@email.com").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

    • Marcado como Resposta Cronemberger08 quarta-feira, 9 de outubro de 2013 01:33
    quarta-feira, 9 de outubro de 2013 01:13
    Moderador

Todas as Respostas

  • 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("seu@email.com").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

    • Marcado como Resposta Cronemberger08 quarta-feira, 9 de outubro de 2013 01:33
    quarta-feira, 9 de outubro de 2013 01:13
    Moderador
  • Muito Obrigado Felipe!

    Ficou exatamente o que eu precisava!

    quarta-feira, 9 de outubro de 2013 01:25
  • 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?

    quarta-feira, 9 de outubro de 2013 14:02
  • Em qual linha você obtém esse erro?

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

    quinta-feira, 10 de outubro de 2013 01:27
    Moderador
  • 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.

    quinta-feira, 10 de outubro de 2013 02:52
  • 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

    domingo, 13 de outubro de 2013 17:42
    Moderador