Hallo zusammen,

zuerst einmal mein Ziel: Ich möchte am Ende des Jahres eine Auswertung fahren welche Leute kurzfristig auf Outlook Termine abgesagt haben.

Das heißt Excel soll über VBA aus Outlook folgende Informationen ziehen:

• Name des Termins
• Datum des Termins
• Teilnehmer
• Zu- oder Absage jedes einzelnen Teilnehmers
• Zeitpunkt der Zu- oder Absage jedes einzelnen Teilnehmers

Mit diesen Daten lässt sich nun die Auswertung fahren.

Ich bin zu diesem Zeitpunkt so weit gekommen

Ich habe mithilfe von VBA Mails exportiert. Hierfür als Grundlage die Zusage oder Absagemails, die gesendet werden wenn man auf eine Besprechung antwortet. Hiermit habe ich alle Informationen, bis auf die Info wann der Termin stattfindet.

Gibt es hier eine Möglichkeit dieses Datum aus den Besprechungsantworten mit zu exportieren?

Anbei der bisherige Code, den ich auch aus verschiedenen Foren habe und etwas angepasst habe.

Vielen Dank und viele Grüße

Jonas

PS: Der Quellcode wird über einen Button ausgelöst.

Private Sub ToggleButton1_Click()

    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 = TextBox1.Value
 
    Pst_Folder_Name = TextBox2.Value

    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) = "Datum"
    ThisWorkbook.Sheets(1).Cells(1, 4) = "EmailID"
    
    oRow = 1
    For iRow = 1 To Folder.Items.Count
        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, 3) = Folder.Items.Item(iRow).ReceivedTime
           ThisWorkbook.Sheets(1).Cells(oRow, 4) = Folder.Items.Item(iRow).SenderEmailAddress
        End If
    Next iRow
    MsgBox "Mails wurden erfolgreich exportiert"
    Set Folder = Nothing
    Set sFolders = Nothing
    
End_Lbl1:
End Sub