Outlook: VBA Zählen von eMails pro Tag / Woche / Monat in CSV

[micha]

Guten Morgen,

Auf Grund eines neuen Jobs erhalte ich jede Menge eMails und würde daher nun gerne aufzeigen , wie sich die Anzahl Mails im Verlauf der letzten Wochen entwickelt haben. Da ich VBA nur als bestenfalls Kauderwelsch kann, wollte ich fragen, ob jemand mir helfen kann angefügten VBA durch eine Schleife (startdatum, zieldatum) zu ergänzen und den Output statt in einer Textbox in eine CSV zu speichern.

Ich habe einen Code Schnipsel gefunden, der letztlich das macht, was ich will - aber nur für einen Tag, statt für einen Zeitraum und nur als Message, statt als CSV. Ich schätze der Aufwand für einen Erfahrenen das umzubasteln sollte 5-10 Minuten sein

Sub Countemailsperday()
    Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder
    Dim EmailCount As Integer
    Dim oDate As String
    
    oDate = InputBox("Type the date for count (format YYYY-m-d")
    Set objOutlook = CreateObject("Outlook.Application")
    Set objnSpace = objOutlook.GetNamespace("MAPI")
        On Error Resume Next
        Set objFolder = Application.ActiveExplorer.CurrentFolder
        If Err.Number <> 0 Then
        Err.Clear
        MsgBox "No such folder."
        Exit Sub
        End If
    EmailCount = objFolder.Items.Count
    MsgBox "Number of emails in the folder: " & EmailCount, , "email count"
    Dim ssitem As MailItem
    Dim dateStr As String
    Dim myItems As Outlook.Items
    Dim dict As Object
    Dim msg As String
    Set dict = CreateObject("Scripting.Dictionary")
    Set myItems = objFolder.Items
    myItems.SetColumns ("ReceivedTime")
    ' Determine date of each message:
    For Each myItem In myItems
        dateStr = GetDate(myItem.ReceivedTime)
        If dateStr = oDate Then
            If Not dict.Exists(dateStr) Then
                dict(dateStr) = 0
            End If
            dict(dateStr) = CLng(dict(dateStr)) + 1
        End If
    Next myItem
    ' Output counts per day:
    msg = ""
    For Each o In dict.Keys
        msg = msg & o & ": " & dict(o) & " items" & vbCrLf
    Next
    MsgBox msg
    Set objFolder = Nothing
    Set objnSpace = Nothing
    Set objOutlook = Nothing
End Sub
Function GetDate(dt As Date) As String
    GetDate = Year(dt) & "-" & Month(dt) & "-" & Day(dt)
End Function

Vielen Dank,

Micha