Notizen aus dem Softwareentwickler & IT-Administrator Alltag, aber auch Kochrezepte. Mehr gibt es auf Bernds Blog und mehr über mich auf berrnd.de.

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 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
    Next
End Sub

Schreibe einen Kommentar

Deine E-Mail-Adresse wird nicht veröffentlicht. Erforderliche Felder sind mit * markiert.

Sidebar