Public Sub Termin_Outlook(StartD As Date, StartZ As Date, _
    EndD As Date, EndZ As Date, Betreff As String, Text As String, Kategorie As _
    String)
 
    On Error GoTo Fehler
 
    Dim objApp     As Object  ' Outlook Applikation
    Dim objItem    As Object  ' Termin Objekt
    Dim StartRange As Date    ' Start Datum
    Dim EndRange   As Date    ' End Datum
    Dim intAnswer  As Integer ' Antwort
 
    StartRange = StartD & " " & StartZ
    EndRange = EndD & " " & EndZ
 
    ' Erzeugen einer einer Outlook-Instanze
    Set objApp = CreateObject("Outlook.Application")
 
    ' Erzeugen eines Termins
    Set objItem = objApp.CreateItem(olAppointmentItem)
 
    ' Mit Termin-Objekt
    With objItem
        ' Betreff definieren
        .Subject = Betreff
        ' Ort definieren
        .Location = txtStadt.Text
        ' Startdatum zuweisen
        .Start = StartRange
        ' Enddatum zuweisen
        .End = EndRange
        ' Weiteren Text zuweisen
        .Body = Text
        ' Kategorie definieren
        .Categories = Kategorie
 
        ' Methoden anwenden 'Termin speichern
        .Save
        intAnswer = MsgBox("Termin wurde eingetragen. Wollen Sie ihn anzeigen" & _
          "lassen?", 36)
        If intAnswer = vbYes Then
            ' Termin anzeigen
            .Display (True)
        End If
 
    End With
    ' Objekte freigeben
    Set objItem = Nothing
    Set objApp = Nothing
 
    Exit Sub
Fehler:
    MsgBox "Error:" & Err & " " & Error, vbCritical, "Unerwarter Fehler"
 
End Sub