Views

Histats

Vitrine

VBA Access - Lendo E-mails do Outlook do Access

Você tem e-mails que gostaria de ver inseridos automaticamente no seu banco de dados ou apenas visualizar o seu conteúdo?
 
O seguinte trecho de código é um exemplo de como fazer isso. Funciona com o Outlook 97, 98 e 2000. Lembre-se de adicionar a referência do MS Outlook para o seu banco de dados ou projeto antes de executar este código.
 
Public Sub ImportOutlookItems()     Dim Olapp As Outlook.Application     Dim Olmapi As Outlook.NameSpace     Dim Olfolder As Outlook.MAPIFolder     Dim OlAccept As Outlook.MAPIFolder     Dim OlDecline As Outlook.MAPIFolder     Dim OlFailed As Outlook.MAPIFolder     Dim OlMail As Object 'Have to late bind as appointments e.t.c screw it up     Dim OlItems As Outlook.Items     Dim OlRecips As Outlook.Recipients     Dim OlRecip As Outlook.Recipient     Dim Rst As DAO.Recordset
    Set Rst = CurrentDb.OpenRecordset("tbl_Temp") ' Abre a tabela table tbl_temp
' Cria uma conexão com o Outlook.     Set Olapp = CreateObject("Outlook.Application")     Set Olmapi = Olapp.GetNamespace("MAPI")
'Abre a pasta Inbox.     Set Olfolder = Olmapi.GetDefaultFolder(olFolderInbox)     Set OlItems = Olfolder.Items
' Configura as pastas que estão configuradas como repositórios de mensagens.
    Set OlAccept = Olfolder.folders("Accept")     Set OlDecline = OLfolder.Folders("Decline")     Set OlFailed = Olfolder.Folders("Failed")
    Do Until OlItems.Count = 0 ' Set up a loop to run till the inbox is empty (otherwise it skips some)     Set OlItems = OLfolder.Items 'Reset the olitems object otherwise new incoming mails and moving mails get missed     For Each OlMail In OlItems
    If OlMail.UnRead = True Then 'For each mail in the collection check the subject line and process accordingly         Let OlMail.UnRead = False 'Marca o e-mail como lido.
        Rst.AddNew
        Let Rst!Name = OlMail.SenderName
        If InStr(1, OlMail.Subject, "Accept") > 0 Then             Let Rst!status = "Attending"             Let Rst!datesent = OlMail.ReceivedTime
            OlMail.Move OlAccept
        ElseIf InStr(1, OlMail.Subject, "Decline") > 0 Then             Let Rst!datesent = OlMail.ReceivedTime             Let Rst!status = "Decline"
            OlMail.Move OlDecline
        Else             Let Rst!datesent = OlMail.ReceivedTime             Let Rst!status = "Failed"
            OlMail.Move OlFailed         End If
        Rst.Update     End If     Next     Loop     MsgBox "Nova mensage foi checada. Por favor check a tabela tbl_temp para mais detalhes", vbOKOnly
End Sub
 
André Luiz Bernardes

✔ VBA Brazil®

✔ VBA Brazil®
brazilsalesforceeffectiveness@gmail.com
Related Posts Plugin for WordPress, Blogger...
diHITT - Notícias