Advanced Search

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"
                .AddNew
                !Subject = Mailobject.Subject
                !From = Mailobject.SenderName
                !To = Mailobject.To
                !Body = Mailobject.Body
                !DateSent = Mailobject.SentOn
                .Update
            End With
            rst.Close
            End If
          
        Next
    
    
    
    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