Hallo zusammen,

ich versuche mithilfe eines Makros in Excel Emails aus Outlook zu exportieren. Hierbei handelt es sich um Antworten auf Besprechungsanfragen, also Zugesagt bzw Abgesagt. Das funktioniert zum jetzigen Zeitpunkt prima, jedoch fehlt mir eine wichtige Komponente. Die Zeit des Termins. 

Ich habe leider keine Ahnung wie dieses Feld exportieren kann. Hintergrund ist, dass ich eine Auswertung fahren will, die zeigt welche Teilnehmer zum Beispiel einen Tag  vor einer Besprechung bzw. in unserem Fall Schulungen abgesagt hat.

Ich hoffe jemand kann mir helfen.

Vielen Dank & viele Grüße

Jonas

Folgendes Makro habe ich aus anderen Foren und etwas angepasst:

Option Explicit
Sub VBA_Export_Outlook_Emails_To_Excel()

    Dim Folder As Outlook.MAPIFolder
    Dim sFolders As Outlook.MAPIFolder
    Dim iRow As Integer, oRow As Integer
    Dim MailBoxName As String, Pst_Folder_Name  As String
    
    MailBoxName = "Test@example.de"
 
    Pst_Folder_Name = "Test"

    For Each Folder In Outlook.Session.Folders(MailBoxName).Folders
        If VBA.UCase(Folder.Name) = VBA.UCase(Pst_Folder_Name) Then GoTo Label_Folder_Found
        For Each sFolders In Folder.Folders
            If VBA.UCase(sFolders.Name) = VBA.UCase(Pst_Folder_Name) Then
                Set Folder = sFolders
                GoTo Label_Folder_Found
            End If
        Next sFolders
    Next Folder
 
Label_Folder_Found:
     If Folder.Name = "" Then
        MsgBox "Invalid Data in Input"
        GoTo End_Lbl1:
    End If
 
    ThisWorkbook.Sheets(1).Activate

    ThisWorkbook.Sheets(1).Cells(1, 1) = "Sender"
    ThisWorkbook.Sheets(1).Cells(1, 2) = "Termin"
    ThisWorkbook.Sheets(1).Cells(1, 3) = "Zugesagt / Abgesagt"
    ThisWorkbook.Sheets(1).Cells(1, 4) = "Betreff"
    ThisWorkbook.Sheets(1).Cells(1, 5) = "Datum"
    ThisWorkbook.Sheets(1).Cells(1, 6) = "EmailID"
    
    oRow = 1
    For iRow = 1 To Folder.Items.Count
        'If condition to import mails received in last 60 days
        'To import all emails, comment or remove this IF condition
        If VBA.DateValue(VBA.Now) - VBA.DateValue(Folder.Items.Item(iRow).ReceivedTime) <= 60 Then
           oRow = oRow + 1
           ThisWorkbook.Sheets(1).Cells(oRow, 1).Select
           ThisWorkbook.Sheets(1).Cells(oRow, 1) = Folder.Items.Item(iRow).SenderName
           ThisWorkbook.Sheets(1).Cells(oRow, 2) = Folder.Items.Item(iRow).Subject
           ThisWorkbook.Sheets(1).Cells(oRow, 5) = Folder.Items.Item(iRow).ReceivedTime
           ThisWorkbook.Sheets(1).Cells(oRow, 6) = Folder.Items.Item(iRow).SenderEmailAddress
        End If
    Next iRow
    MsgBox "Mails wurden erfolgreich exportiert"
    Set Folder = Nothing
    Set sFolders = Nothing
    
End_Lbl1:
End Sub