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
Nenhum comentário:
Postar um comentário