' tNewAppDate  -  "30.11.2017 09:00"
If tNewAppDate >= obj.start And tNewAppDate <= obj.end Then

Public Function AppointmentsAtDay(ByVal oFLD As Outlook.MAPIFolder, _
                                  ByVal dtDate As Date, _
                                  Optional oResult As Outlook.Items) As Date
  Dim oItems As Outlook.Items
  Dim sFind As String
  Dim obj As Object
  Dim i As Long: i = 0
  Dim maxLoop As Byte: maxLoop = 0
 
  Set oItems = oFLD.Items
 
  oItems.Sort "[Start]", False
  oItems.IncludeRecurrences = True
 
  sFind = Format(dtDate, "ddddd")
 
  sFind = "[Start] <= " & Chr(34) & sFind & " 12:00 PM" & Chr(34) & " AND " & _
          "[End] > " & Chr(34) & sFind & " 00:00 AM" & Chr(34)
 
  Set oResult = oItems.Restrict(sFind)
  For Each obj In oResult
    i = i + 1
  Next
 
Dim tNewAppDate As Date
    tNewAppDate = dtDate
 
checkAgain:
' ### Schutz vor Endlos-Schleife
maxLoop = maxLoop + 1
If maxLoop >= 15 Then GoTo keinTermin
 
 
    Dim habeKonflikt As Boolean: habeKonflikt = False
    Debug.Print "Versuche : " & tNewAppDate
 
    ' ### Die Appointments filtern und ausgeben
    For Each obj In oResult.Restrict(sFind)
         If tNewAppDate >= obj.start And tNewAppDate <= obj.end Then
           Debug.Print "Konflikt! - START: " & obj.start & " ENDE: " & obj.end, _
             "neu: " & tNewAppDate
           habeKonflikt = True
         End If
    Next obj
 
      ' ### 15 Min Zuschlag für nächsten Termin
    If habeKonflikt = True Then
        tNewAppDate = DateAdd("N", 15, tNewAppDate)
            GoTo checkAgain
    End If
 
  AppointmentsAtDay = tNewAppDate
 
finALLY:
    Exit Function
 
keinTermin:
    MsgBox "ACHTUNG", vbInformation, "kein Termin FREI"
    GoTo finALLY
 
errHand:
    Debug.Print Now & " - es ist ein Fehler aufgetreten"
    Debug.Print Err.Number & "|" & Err.Description
    Debug.Print "mod_OLTermin - in AppointmentsAtDay"
        GoTo finALLY
End Function