Macro para e-mail's com assunto "Lida: " recebido no Outlook e salvar em um banco MySql

Question

Copiei a rotina abaixo em meu projeto porém da erro: "Tipos Incompatíveis" na linha:
For Each olItem In olFolder.Items
O que estou fazendo de errado.
Sub GerarLista()

    Dim olNS As Outlook.NameSpace
    Dim olFolder As Outlook.Folder
    
    Set olNS = Application.GetNamespace("MAPI")
    'Troque a constante abaixo se desejar que se faça varredura em outra pasta.
    Set olFolder = olNS.GetDefaultFolder(olFolderInbox)
    
    'Limpa Planilha
    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
    
    For Each olItem In olFolder.Items
        'Você pode visualizar uma série de propriedades de um objeto MailItem. Exemplos:
        Debug.Print olItem.Subject 'Assunto do e-mail
        Debug.Print olItem.SenderEmailAddress 'E-mail do remetente
        Debug.Print olItem.To 'E-mail do destinatário
        Debug.Print olItem.ReceivedTime 'Data/Hora de recebimento
        Debug.Print olItem.Attachments.Count 'Número de anexos
        Debug.Print olItem.Size 'Tamanho da mensagem em bytes
        Debug.Print olItem.Body 'Corpo do documento
        
        '***A rotina para adicionar o corpo do email à sua base de dados ficaria aqui***
    Next olItem
    
    For Each olSubFolder In olFolder.Folders
        DescePasta olSubFolder
    Next olSubFolder
    
End Sub

Answer 1

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 Object
    
    r = r + 1
    Cells(r, "A") = olFolder.FolderPath
    For Each olItem In olFolder.Items
        If TypeName(olItem) = "MailItem" Then
        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
        End If
    Next olItem
    
    For Each olSubFolder In olFolder.Folders
        DescePasta olSubFolder
    Next olSubFolder
    
End Sub

---

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

Answer 2

Caro Felipe,

Obrigado pelo atendimento, mas o fato do "if" pular os e-mail's "Lida" não resolve meu problema.

O que acontece é que o sistema envia e-mails de todas as notas fiscais, boletos e confirmações de pagamentos em um PDF. Preciso que o sistema grave na tabela de Notas Fiscais que o e-mail enviado referente aquela nota foi lido no endereço de e-mail tal, na data tal. Portanto preciso de um script que leia os e-mails com assunto: "Lida" ou "Read". O que não está acontecendo!

Agradeço uma resposta, mesmo que a resposta seja: não tem jeito!

Answer 3

Se o "lida" está no assunto do e-mail mesmo, você pode fazer algo como mostrado a seguir:

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 Object
    
    r = r + 1
    Cells(r, "A") = olFolder.FolderPath
    For Each olItem In olFolder.Items
        If TypeName(olItem) = "MailItem" Then
          If olItem.Subject Like "*Lida*" _
          Or olItem.Subject Like "*Read*" Then
            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
          End If
        End If
    Next olItem
    
    For Each olSubFolder In olFolder.Folders
        DescePasta olSubFolder
    Next olSubFolder
    
End Sub

---

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

Answer 4

Felipe, mais uma vês obrigado pelo seu pronto atendimento. Porém não está acontecendo nada.

Vou tentar descrever o que estou entendendo. É como se os e-mails de confirmação de leitura não fossem do tipo "MailItem" mas outro tipo, pois de 100 e-mails, onde tenha 80 e-mails de confirmação de leitura (tipo: Lida, Read, etc), a rotina criada por você acima, lê somente os 20 e-mails comuns.

Quando coloco a lista de e-mails no Microsoft Outlook 2010 em ordem de "Classificado por ícone", ele divide em duas classes:

Os e-mails comuns aparecem em uma lista que ele (o programa Microsoft Outlook 2010) denomina de:

"Classe de mensagem: Mensagem (20 itens, 5 não lido)"

e os e-mails de confirmação de leitura de:

"Classe de mensagem: Relatório Lido (Mensagem) 80 itens, 68 não lido).

Será que deverei referenciar a variável "olItem" como sendo diferente de object???

Answer 5

Ola Felipe,

O que descobri até o momento é que o e-mail de confirmação de leitura é do tipo ReportItem, que dentro de suas propriedades existe por exemplo o .Subject mas não existe a propriedade .SenderEmailAddress.

Você conhece este tipo? Sabe como posso conseguir o endereço do remetente para este tipo?

O que acontece é que posso enviar um e-mail para varias pessoas, solicitando confirmação de leitura e somente 2 delas lerem, assim seria muito bom poder gravar o endereço de e-mail de cada e-mail de confirmação de leitura.

Answer 6

Obrigado por detalhar a explicação.

Você está certo, a confirmação de leitura é um outro tipo de objeto, e no seu caso, o que deve-se estudar é o ReportItem.

Infelizmente, não há um link direto entre a confirmação de leitura de um determinado e-mail. Você terá que usar um filtro explicado neste link: http://stackoverflow.com/questions/13364815/how-to-get-the-mailitem-belonging-to-a-read-receipt-reportitem-via-outlook-aut

O link demonstra um exemplo de C#, mas é um bom início para você tentar adaptar sua solução para VBA.

---

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