Private m_oConnection As ADODB.Connection
Private m_oCmdGetAppointments As ADODB.Command
 
'Open the database connection
Public Sub OpenDatabaseConnection()
    On Error GoTo ErrorHandler
 
    If Len(m_sDatabasePath) = 0 Then
        m_sDatabasePath = m_oParentForm.FileSelection
    End If
 
    Set m_oConnection = New ADODB.Connection
 
    m_oConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                       "Data Source=" & m_sDatabasePath
 
    If m_oConnection.State <> adStateOpen Then
        Set m_oConnection = Nothing
        MsgBox "Could not open connection to database", vbCritical + vbOKOnly, App.Title
        Exit Sub
    End If
 
    Exit Sub
ErrorHandler:
    HandleError "clsDatabaseHandler:OpenDatabaseConnection Sub"
End Sub
 
 
'Method to get the appointments from the database
Public Function GetAppointments(ByVal sDate As String, ByRef oRsAppts As ADODB.Recordset)
    On Error GoTo ErrorHandler
 
    If m_oCmdGetAppointments Is Nothing Then
        Set m_oCmdGetAppointments = New ADODB.Command
 
        With m_oCmdGetAppointments
            Set .ActiveConnection = m_oConnection
 
            .CommandText = "qryApptList"
            .CommandType = adCmdStoredProc
 
            .Parameters.Append .CreateParameter("DateOfAppt", adVarChar, adParamInput, 11)
        End With
    End If
 
    m_oCmdGetAppointments.Parameters("DateOfAppt") = sDate
 
    Set oRsAppts = New ADODB.Recordset
 
    oRsAppts.Open m_oCmdGetAppointments, , adOpenStatic, adLockReadOnly
 
    Exit Function
ErrorHandler:
    HandleError "clsDatabaseHandler:GetAppointments Function"
End Function

PARAMETERS DateOfAppt Text ( 255 );
SELECT tblAppointments.ApptId, tblAppointments.User, tblAppointments.ApptDate, tblAppointments.ApptTime, tblAppointments.ClientId, tblAppointments.Comments, tblClients.Title, tblClients.FirstName, tblClients.Surname, tblClients.ContactNumber1
FROM tblClients INNER JOIN tblAppointments ON tblClients.ClientId=tblAppointments.ClientId
WHERE tblAppointments.ApptDate=[DateOfAppt];

Public Function GetAppointments(ByVal sDate As String, ByRef oRsAppts As ADODB.Recordset)
    On Error GoTo ErrorHandler
 
    Dim oCommand As ADODB.Command
 
    If oCommand Is Nothing Then
        Set oCommand = New ADODB.Command
 
        With oCommand
            Set .ActiveConnection = m_oConnection
 
            .CommandText = "qryApptList"
            .CommandType = adCmdStoredProc
 
            .Parameters.Append .CreateParameter("DateOfAppt", adVarChar, adParamInput, 20)
        End With
    End If
 
    oCommand.Parameters("DateOfAppt") = sDate
 
    Set oRsAppts = New ADODB.Recordset
 
    oRsAppts.CursorLocation = adUseClient
 
    oRsAppts.Open oCommand, , adOpenStatic, adLockReadOnly
 
    Set oCommand = Nothing
 
    Exit Function
ErrorHandler:
    HandleError "clsDatabaseHandler:GetAppointments Function"
End Function