Outlook E-Mails auslesen und die in einem SQL Datenbank speichern

Option Compare Database
Option Explicit

Sub TestAccessDB_Outlook()

    Dim oA As New Outlook.Application
    Dim o_NS As Outlook.NameSpace
    Dim oFs As Outlook.Folders
    Dim oFolder As Outlook.MAPIFolder
    Dim Inbox As Outlook.MAPIFolder
    Dim Drafts As Outlook.MAPIFolder
    Dim Archive As Outlook.MAPIFolder
    Dim MailFolder As Outlook.MAPIFolder
    Dim AdobeFolder As Outlook.MAPIFolder
    Dim MailItem As Outlook.MailItem
    Dim oItem As Outlook.MailItem
    Dim i As Long
    Dim intAttachement As Integer
    Dim intCounter As Integer
    Dim intItem As Integer
    Dim strMailbox As String
    Dim strInbox As String
    Dim strDrafts As String
    Dim strArchive As String
    Dim strDatabase As String
    Dim strAttachementType As String
    Dim Anzahl As Integer
    Dim EmailCount As Integer
    Dim db As Database
    Dim rs As Recordset
    Dim strSQL As String
    
    
    
    ' Datenbankverbindung herstellen  
    strDatabase = "C:\Users\username\Documents\Uebung.accdb"  
    Set db = CurrentDb
    
    ' Datensatz aus Tabelle öffnen  
    strSQL = "Select * FROM tbl_Email_Log;"  
    Set rs = db.OpenRecordset(strSQL)
    
   
    rs.AddNew
    
    rs!Betreff = "Test2"  
    rs!Datum_gesendet = Now()
    'rs!Betreff = oItem.Subject  
    rs.Update
    rs.Close
        
    ' Outlookverbindung herstellen  
    Set o_NS = oA.GetNamespace("MAPI")  
    o_NS.Logon , , , False
    Set oFs = o_NS.Folders

    'Hier müssen noch die Werte aus der zu öffnenden Outlook Mailbox rein  
    strMailbox = "email@email.com"  
    strInbox = "Posteingang"  
    strArchive = ""  
 
    Set oFolder = oFs.Item(strMailbox)
    Set Inbox = oFolder.Folders(strInbox)
    Set AdobeFolder = Inbox.Folders("Adobe")  
    Set MailFolder = o_NS.GetDefaultFolder(olFolderOutbox)


    ' Alle Mails im Posteingang zählen  
    For intItem = Inbox.Items.Count To 1 Step -1
    EmailCount = Inbox.Items.Count
    
    
         ' Nur ungelesene Mails bearbeiten  
        If Inbox.Items(intItem).UnRead = True Then
         ' Feststellen, um welche Objekt-Klasse es sich handelt und nur Mails bearbeiten  
            If Inbox.Items(intItem).Class = olMail Then
                Set oItem = Inbox.Items(intItem)
                rs!Betreff = oItem.Subject
                rs!Datum_gesendet = oItem.SentOn
                     If Not oItem.Attachments.Count = 0 Then
                    For intAttachement = 1 To oItem.Attachments.Count
                       ' Nur Mails mit PDF-Anlagen bearbeiten  
                        strAttachementType = Right(oItem.Attachments.Item(intAttachement).FileName, 3)
                        If UCase(strAttachementType) = "PDF" Then  
                            Anzahl = Anzahl + 1
                          End If
                    Next
                 End If
            End If
         End If
    Next
' MsgBox "Email gefunden mit PDF " & Anzahl & " von Insgesamt " & EmailCount & " E-Mail"  
End Sub