Advanced Search

Extract Emails from Outlook into Access Database

/ Published in: Visual Basic
Save to your folder(s)

Expand | Embed | Plain Text

Copy this code and paste it in your HTML 
  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


Comments

RSS Icon Subscribe to comments

You need to login to post a comment.