Visual Basic - Problema al consultar tablas (codigo)

Aqui te mando el codigo que uso para consultar una de las tablas, junto con el form_load() y una rutina que uso para mostrar el contenido de un "Grid" y la rutina de limpieza de los campos en la pantalla, olvide decir que si me salgo de la "Forma" y vuelvo a entrar puedo volver a consultar una fecha (pero solo la primera que digite), en otras palabras, para consultar varias fechas debo salir y volver a entrar a la forma.

Te agradecería mucho cualquier ayuda que me puedas dar.

Private Sub Form_Load()
SICOI.Hide
ConsultaCierres.Show
Dim basedatos1 As Database
Dim TotServi1 As Recordset

Set basedatos1 = Workspaces(0).OpenDatabase(App.Path & "\Bitacora.mdb")
Set TotServi1 = basedatos1.OpenRecordset("TotServiciosAcu", dbOpenTable)
Totalrec = TotServi1.RecordCount

TotLineas = Totalrec
TotLineas = TotLineas + 1

Detalle.Rows = TotLineas
Detalle.ColWidth(0) = 700
Detalle.ColWidth(1) = 1500

Totalrec = 0
TotalRec1 = 0

Linea = 1

Detalle.ColWidth(1) = 1500

Detalle.Row = 0
Detalle.Col = 0
Detalle.CellAlignment = flexAlignCenterCenter
Detalle.Text = "Cantidad"
Detalle.Col = 1
Detalle.CellAlignment = flexAlignCenterCenter
Detalle.Text = "Servicio"
Detalle.Col = 2
Detalle.CellAlignment = flexAlignCenterCenter
Detalle.Text = "Total"

TxtFecha1.SetFocus
End Sub

Public Sub CmdDiario_Click()
Dim basedatos1 As Database
Dim Diarios1 As Recordset

Dim TotalNav1 As Integer

Set basedatos1 = OpenDatabase(App.Path & "\Bitacora.mdb")
Set Diarios1 = basedatos1.OpenRecordset("Diario", dbOpenTable)

If Diarios1.EOF Then
MsgBox "La base de datos esta basia"
TxtFecha1.Text = " "
TxtFecha1.SetFocus
Else
Diarios1.MoveFirst
Do While Not Diarios1.EOF
If TxtFecha1.Text <> Diarios1!Fecha Then
Diarios1.MoveNext
If Diarios1.EOF Then
MsgBox "Esta fecha no existe"
TxtFecha1.SetFocus
Exit Sub
End If
ElseIf TxtFecha1.Text = Diarios1!Fecha Then
Fecha.Caption = Diarios1!Fecha
Totcliente.Caption = Diarios1!Totclientes
TotalNav.Caption = Format(Diarios1!Total, "##,###")
TotalNav1 = TotalNav.Caption
CmdLimpiar.SetFocus
Exit Do
End If
Loop
End If
TipoCierre = 1
Call Servicios

End Sub

Public Sub Servicios()
Dim basedatos1 As Database
Dim TotServi1 As Recordset

Set basedatos1 = Workspaces(0).OpenDatabase(App.Path & "\Bitacora.mdb")
If TipoCierre = 1 Then
Set TotServi1 = basedatos1.OpenRecordset("TotServiciosAcu", dbOpenTable)
ElseIf TipoCierre = 2 Then
Set TotServi1 = basedatos1.OpenRecordset("TotServiciosM", dbOpenTable)
ElseIf TipoCierre = 3 Then
Set TotServi1 = basedatos1.OpenRecordset("TotServiciosA", dbOpenTable)
End If
Dim Total1 As Long

Linea1 = TotServi1.RecordCount
Linea1 = Linea1 + 1

Detalle.Rows = Linea1

Linea = 1
If TotServi1.EOF Then
Exit Sub
Else
Do While Not TotServi1.EOF
If TotServi1.EOF Then
Linea = 1
LblTotalServ.Caption = Format(Total1, "##,###")
CmdLimpiar.SetFocus
Exit Do
End If
Detalle.Row = Linea
Detalle.Col = 0
Detalle.Text = TotServi1!Cantidad
Detalle.Col = 1
Detalle.Text = TotServi1!descripcion
Detalle.Col = 2
Detalle.Text = Format(TotServi1!Total, "##,###")
Total1 = Total1 + TotServi1!Total
TotServi1.MoveNext
Linea = Linea + 1
If TotServi1.EOF Then
Linea = 1
LblTotalServ.Caption = Format(Total1, "##,###")
CmdLimpiar.SetFocus
Exit Do
End If
Loop
End If
Total1 = Total1 + Val(TotalNav.Caption)
GranTotal.Caption = Format(Total1, "###,###") 'Muestra el total diario en pantalla.
TipoCierre = 0
End Sub

Private Sub CmdLimpiar_Click()
Fecha.Caption = " "
Totcliente.Caption = " "
TotalNav.Caption = " "
LblTotalServ.Caption = " "
TxtFecha1.Text = " "
TxtFecha1.SetFocus

Linea1 = Linea1 - 1
Linea = 1
Do While Linea <= Linea1
Detalle.Row = Linea
Detalle.Col = 0
Detalle.Text = " "
Detalle.Row = Linea
Detalle.Col = 1
Detalle.Text = " "
Detalle.Row = Linea
Detalle.Col = 2
Detalle.Text = " "
Detalle.Row = Linea
Linea = Linea + 1
If Linea > Linea1 Then
Linea = 1
Exit Do
End If
Loop
Linea = 1
GranTotal.Caption = ""

End Sub

Set Diarios1 = basedatos1.OpenRecordset("Diario", dbOpenTable)
Esta Instrucción la cambiaría por:
Set Diarios1 = BaseDatos1.Openrecordset("Diario", dbOpenDynaset)

Creo que lo otro pasa por la forma de la busqueda, puedes hacerlo de la siguiente forma:
Sub txtfecha_LostFocus()
Validar la fecha
end sub
sub cmdDiario_Click()
strbusca = "fecha=" & txtfecha.text (Pruba tambien con ".Value")
Diarios1.findfirst strbusca
if Diarios1.nomatch then (lo que quieras) salir,Mensajes, Etc.
Do While Not Diarios1.EOF
Completa DBGrid con los Datos
Te envío código de Ejemplo más especifico a tu E-Mail
Diarios1.FindNext strbusca
loop
NOTAS:
Diarios1.FindNext strBusca 'Completa Grid Con Datos coincidentes, habitualmente el Grid lo inicio con 2 filas (1º linea de Titulos y 2º linea de Datos) y tantas columnas como necesite, y a medida que requiero más filas se las agrego vía código