Resturlaub berechnen (Outlook Makro)

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

    ' Festlegungen:
    ' - Definition von Urlaubsanspruch und Sollzeit erfolgt in Terminen
    '   mit Betreff "ResturlaubParameter" und Ort "Urlaubsanspruch=;Sollzeit=;CsvExportPath=",
    '   die Sollzeit und der Exportpfad für die CSV-Dateien gilt dann entsprechend,
    '   der Urlaubsanspruch erhöht sich um den angegebenen Wert ab diesem Termin
    '
    ' - Urlaubstermine müssen "Urlaub" im Betreff enthalten und der Kategorie "Geschäftlich" zugeordnet sein
    '
    ' - Urlaub darf nicht jahresübergreifend (ein Termin über Jahresgrenze) eingetragen sein

    ' - Urlaub kann auch stundenweise im Kalender eingetragen werden (wird dann anhand
    '   der definierten Sollzeit, auf eine Stelle nach dem Komma gerundet, berücksichtigt)

    Set kalender = Application.Session.GetDefaultFolder(olFolderCalendar)
    Set termine = kalender.Items

    resturlaub = 0
    urlaubsanspruchDiesesJahr = 0
    yearLastTermin = -1
    urlaubGenommenDiesesJahr = 0
    csvTextUrlaubstage = "DatumStart;DatumEnde;Tage;Resturlaub" + vbCrLf
    csvTextUrlaubstageYearly = "Jahr;Urlaubstage;Urlaubsanspruch" + vbCrLf
    csvTextResturlaubYearly = "Jahr;Resturlaub" + vbCrLf
    csvTextResturlaubNachKw2 = "Jahr;Resturlaub" + vbCrLf
    csvTextResturlaubNachOktober = "Jahr;Resturlaub" + vbCrLf
    resturlaubNachKw2 = -1
    resturlaubNachOktober = -1

    termine.Sort "[Start]"
    For Each termin In termine
        weekNumber = DatePart("ww", termin.Start, vbMonday, vbFirstFullWeek)

        If Year(termin.Start) > yearLastTermin Then
            If urlaubGenommenDiesesJahr > 0 Or yearLastTermin = Year(Now) + 1 Then
                csvTextUrlaubstageYearly = csvTextUrlaubstageYearly + CStr(yearLastTermin) + ";" + CStr(urlaubGenommenDiesesJahr) + ";" + CStr(urlaubsanspruchDiesesJahr) + vbCrLf
                csvTextResturlaubYearly = csvTextResturlaubYearly + CStr(yearLastTermin) + ";" + CStr(resturlaub) + vbCrLf
                csvTextResturlaubNachKw2 = csvTextResturlaubNachKw2 + CStr(yearLastTermin) + ";" + CStr(resturlaubNachKw2) + vbCrLf
                csvTextResturlaubNachOktober = csvTextResturlaubNachOktober + CStr(yearLastTermin) + ";" + CStr(resturlaubNachOktober) + vbCrLf
            End If

            urlaubGenommenDiesesJahr = 0
            resturlaubNachKw2 = -1
            resturlaubNachOktober = -1
        End If
        yearLastTermin = Year(termin.Start)

        If termin.Subject = "ResturlaubParameter" Then
            For Each parameterElement In Split(termin.Location, ";")
                parameterParts = Split(parameterElement, "=")
                If parameterParts(0) = "Sollzeit" Then
                    sollzeit = CDbl(parameterParts(1)) * 60
                End If
                If parameterParts(0) = "Urlaubsanspruch" Then
                    urlaubsanspruchDiesesJahr = CDbl(parameterParts(1))
                    resturlaub = resturlaub + urlaubsanspruchDiesesJahr
                End If
                If parameterParts(0) = "CsvExportPath" Then
                    csvExportPath = parameterParts(1)
                End If
            Next
        End If

        If Not InStr(termin.Categories, "Geschäftlich") = 0 And Not InStr(termin.Subject, "Urlaub") = 0 Then
            If termin.AllDayEvent Then 'Ganztägiges Ereignis, Sollzeit muss nicht berücksichtigt werden
                dauerTageCurTermin = termin.Duration / 60 / 24
            Else 'Tagesanteil anhand von Sollzeit berechnen
                dauerTageCurTermin = termin.Duration / sollzeit
            End If

            urlaubGenommenDiesesJahr = urlaubGenommenDiesesJahr + dauerTageCurTermin
            resturlaub = resturlaub - dauerTageCurTermin

            termin.Location = "[Berechnet] Stand nach diesem Urlaub: " + CStr(resturlaub) + " Resturlaubstage; " + _
                CStr(urlaubGenommenDiesesJahr) + " Urlaubstage dieses Jahr"
            termin.Body = "Via Makro berechnet am: " & CStr(Now)
            termin.Save

            csvTextUrlaubstage = csvTextUrlaubstage + Format(termin.Start, "dd.mm.yyyy hh:mm:ss") + ";" + Format(termin.End, "dd.mm.yyyy hh:mm:ss") + ";" + CStr(dauerTageCurTermin) + ";" + CStr(resturlaub) + vbCrLf
        End If

        If weekNumber = 1 Or weekNumber = 2 Or resturlaubNachKw2 = -1 Then
            resturlaubNachKw2 = resturlaub
        End If

        If Month(termin.Start) = 10 Or resturlaubNachOktober = -1 Then
            resturlaubNachOktober = resturlaub
        End If
    Next

    Set fso = New FileSystemObject

    Set stream = fso.CreateTextFile(csvExportPath + "\Urlaubstage.csv", True)
    stream.Write csvTextUrlaubstage
    stream.Close

    Set stream = fso.CreateTextFile(csvExportPath + "\UrlaubstageProJahr.csv", True)
    stream.Write csvTextUrlaubstageYearly
    stream.Close

    Set stream = fso.CreateTextFile(csvExportPath + "\ResturlaubProJahr.csv", True)
    stream.Write csvTextResturlaubYearly
    stream.Close

    Set stream = fso.CreateTextFile(csvExportPath + "\ResturlaubNachKw2.csv", True)
    stream.Write csvTextResturlaubNachKw2
    stream.Close

    Set stream = fso.CreateTextFile(csvExportPath + "\ResturlaubNachOktober.csv", True)
    stream.Write csvTextResturlaubNachOktober
    stream.Close
End Sub