Return to Snippet

Revision: 21123
at December 3, 2009 17:55 by pkd65

Initial Code
Public Sub GetEmails()

    DoCmd.SetWarnings False

    Dim rst              As ADODB.Recordset
    Dim OlApp            As Outlook.Application
    Dim Inbox            As Outlook.MAPIFolder
    Dim InboxItems       As Outlook.Items
    Dim Mailobject       As Object

    Set OlApp = CreateObject("Outlook.Application")
    Set Inbox = OlApp.GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
    Set rst = New ADODB.Recordset
    Set InboxItems = Inbox.Items
        For Each Mailobject In InboxItems
             If (Mailobject.SenderName Like "*[email protected]*") Then

            With rst
                .ActiveConnection = CurrentProject.Connection
                .CursorType = adOpenKeyset
                .LockType = adLockOptimistic
                .Open "Select *from tbl_DigalertMails Order BY DateSent DESC"
                !Subject = Mailobject.Subject
                !From = Mailobject.SenderName
                !To = Mailobject.To
                !Body = Mailobject.Body
                !DateSent = Mailobject.SentOn
            End With
            End If
    Set OlApp = Nothing
    Set Inbox = Nothing
    Set InboxItems = Nothing
    Set Mailobject = Nothing
    Set rst = Nothing
    DoCmd.SetWarnings True

End Sub

Initial URL

Initial Description

Initial Title
Extract Emails from Outlook into Access Database

Initial Tags

Initial Language
Visual Basic