Несколько событий, происходящих в одну и ту же дату

Private Sub Form_Activate()
 
Label2 = Date
 Dim Conn As New ADODB.Connection, RS As New ADODB.Recordset
Conn.Open "Provider = Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\User\Downloads\VB примеры\Nap4\Event_db.accdb;Persist Security Info=False;"
RS.Open "SELECT Da_te, Event, Ti_me, Doctor, Phone, Location, Da_te2 FROM Event_tbl WHERE Da_te =#" + Format$(Date, "mm\/dd\/yyyy") + "#", Conn
If Not RS.EOF Then
 
  
  Label6 = RS("Da_te")
  Label7 = RS("Ti_me")
  Label8 = RS("Doctor")
  Label9 = RS("Phone")
  Label10 = RS("Location")
  Label5 = RS("Event")
   'Label61 = RS("Da_te")
  'Label71 = RS("Ti_me")
  'Label81 = RS("Doctor")
  'Label91 = RS("Phone")
  'Label101 = RS("Location")
  'Label51 = RS("Event")
Else
  Label5 = "Нет событий"
  
End If
RS.Close
Conn.Close
 
End Sub

RS.MoveLast ' две строчки для подсчёта количества записей в таблице
RS.MoveFirst '
For J = 1 To RS.RecordCount ' с начала до конца таблицы
''' эти строки замени если хочешь выводить в лабелы----------------------------------------
.Rows = .Rows + 1 ' прибавить строчку в таблице
    For c = 0 To .Cols - 1
        .TextMatrix(J, c) = RS.Fields(c) ' заполнить значениями
    Next c
""""""---------------------------------------------------------------------
RS.MoveNext ' следующая строка в таблице базы
Next J 'следующая строка