Posted By

pkd65 on 12/03/09


Tagged

access vb Outlook


Versions (?)

Extract Emails from Outlook into Access Database


 / Published in: Visual Basic
 

  1. Public Sub GetEmails()
  2.  
  3.  
  4. DoCmd.SetWarnings False
  5.  
  6.  
  7. Dim rst As ADODB.Recordset
  8. Dim OlApp As Outlook.Application
  9. Dim Inbox As Outlook.MAPIFolder
  10. Dim InboxItems As Outlook.Items
  11. Dim Mailobject As Object
  12.  
  13. Set OlApp = CreateObject("Outlook.Application")
  14. Set Inbox = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
  15. Set rst = New ADODB.Recordset
  16. Set InboxItems = Inbox.Items
  17.  
  18. For Each Mailobject In InboxItems
  19. If (Mailobject.SenderName Like "*[email protected]*") Then
  20.  
  21. With rst
  22. .ActiveConnection = CurrentProject.Connection
  23. .CursorType = adOpenKeyset
  24. .LockType = adLockOptimistic
  25. .Open "Select *from tbl_DigalertMails Order BY DateSent DESC"
  26. .AddNew
  27. !Subject = Mailobject.Subject
  28. !From = Mailobject.SenderName
  29. !To = Mailobject.To
  30. !Body = Mailobject.Body
  31. !DateSent = Mailobject.SentOn
  32. .Update
  33. End With
  34. rst.Close
  35. End If
  36.  
  37. Next
  38.  
  39.  
  40.  
  41. Set OlApp = Nothing
  42. Set Inbox = Nothing
  43. Set InboxItems = Nothing
  44. Set Mailobject = Nothing
  45. Set rst = Nothing
  46. DoCmd.SetWarnings True
  47.  
  48.  
  49. End Sub

Report this snippet  

You need to login to post a comment.