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

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=",
    '  die Sollzeit 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
    reportText = "DatumStart;DatumEnde;Tage;Resturlaub" + vbCrLf
    
    termine.Sort "[Start]"
    For Each termin In termine
        If Year(termin.Start) > yearLastTermin Then
            urlaubGenommenDiesesJahr = 0
        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
            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
            
            reportText = reportText + 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
    Next
    
    If MsgBox("Report speichern (auf dem Desktop, Datei Urlaub.csv)?", vbYesNo, "Frage") = vbYes Then
        Set fso = New FileSystemObject
        Set stream = fso.CreateTextFile(Environ("userprofile") + "\Desktop\Urlaub.csv", True)
        stream.Write reportText
        stream.Close
    End If
End Sub

Schreibe einen Kommentar

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

Sidebar