Zuletzt aktualisiert am 16. Dezember 2018
Aus Abschnitt Microsoft Office Macros und markiert mit

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
    yearLastTermin = -1
    urlaubGenommenLfd = 0
    urlaubGenommenDiesesJahr = 0
    csvTextUrlaubstage = "DatumStart;DatumEnde;Tage;Resturlaub" + vbCrLf
    csvTextUrlaubstageYearly = "Jahr;Urlaubstage" + vbCrLf
    csvTextResturlaubYearly = "Jahr;Resturlaub" + vbCrLf
    csvTextResturlaubNachKw2 = "Jahr;Resturlaub" + vbCrLf
    resturlaubNachKw2 = -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) + vbCrLf
                csvTextResturlaubYearly = csvTextResturlaubYearly + CStr(yearLastTermin) + ";" + CStr(resturlaub) + vbCrLf
                csvTextResturlaubNachKw2 = csvTextResturlaubNachKw2 + CStr(yearLastTermin) + ";" + CStr(resturlaubNachKw2) + vbCrLf
            End If
            
            urlaubGenommenDiesesJahr = 0
            resturlaubNachKw2 = -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
                    resturlaub = resturlaub + CDbl(parameterParts(1))
                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
            
            urlaubGenommenLfd = urlaubGenommenLfd + dauerTageCurTermin
            urlaubGenommenDiesesJahr = urlaubGenommenDiesesJahr + dauerTageCurTermin
            resturlaub = resturlaub - dauerTageCurTermin
            
            termin.Location = "[Berechnet] Stand nach diesem Urlaub: " + CStr(resturlaub) + " Resturlaubstage; " + _
                CStr(urlaubGenommenDiesesJahr) + " Urlaubstage dieses Jahr; " + CStr(urlaubGenommenLfd) + " Urlaubstage insgesamt"
            termin.Body = "Resturlaub 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
    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
End Sub

Schreibe einen Kommentar

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