Pendler-Kalender (Outlook Makro)

Public Sub Pendlerkalender()
    ' Hinweise:
    ' - Es wird ein Verweis auf "Microsoft Scripting Runtime" benötigt (Extras -> Verweise)

    Set termine = Application.Session.GetDefaultFolder(olFolderCalendar).Folders("Pendlerkalender").Items
    Set tageInsgesamt = New Dictionary
    Set tageThisYear = New Dictionary
    lastYear = 1000

    termine.Sort "[Start]"
    For Each termin In termine
        If termin.Subject = "Summe" Then
            termin.Body = "Laufende Summe dieses Jahr:" + vbCrLf

            For Each dictKey In tageThisYear.Keys
                termin.Body = termin.Body + dictKey + ": " + CStr(tageThisYear.Item(dictKey)) + " Tage" + vbCrLf
            Next

            termin.Body = termin.Body + vbCrLf + vbCrLf
            termin.Body = termin.Body + "Laufende Summe insgesamt:" + vbCrLf

            For Each dictKey In tageInsgesamt.Keys
                termin.Body = termin.Body + dictKey + ": " + CStr(tageInsgesamt.Item(dictKey)) + " Tage" + vbCrLf
            Next

            termin.Location = ""
            termin.Save
        Else
            If lastYear < Year(termin.Start) Then
                lastYear = Year(termin.Start)
                tageThisYear.RemoveAll
            End If

            If Not tageInsgesamt.Exists(termin.Subject) Then
                tageInsgesamt.Add termin.Subject, 0
            End If
            If Not tageThisYear.Exists(termin.Subject) Then
                tageThisYear.Add termin.Subject, 0
            End If

            currentAnzahlInsgesamt = tageInsgesamt.Item(termin.Subject) + 1
            currentAnzahlThisYear = tageThisYear.Item(termin.Subject) + 1
            tageInsgesamt.Item(termin.Subject) = currentAnzahlInsgesamt
            tageThisYear.Item(termin.Subject) = currentAnzahlThisYear

            termin.Location = "[Berechnet] Stand: Dieses Jahr " + CStr(currentAnzahlThisYear) + " Tage; Insgesamt " + CStr(currentAnzahlInsgesamt) + " Tage"
            termin.Body = "Zuletzt berechnet: " + CStr(Now)
            termin.Save
        End If
    Next
End Sub