FindFirst with Date value-CodePudding

I'm using a splitform to navigate information and I have a command button that selects a record based on today's date.

Private Sub FindDate_Click()
  TodayDate = DateTime.Date
     Me![Start Date].SetFocus
     DoCmd.FindRecord TodayDate
End Sub

I discovered that wouldn't work if the date didn't exist in my recordset.

I modified the code but I get

"Run-time error '3251': Operation is not supported for this type of object."

The new line of code is

Dim CurrDB As DAO.Database
Dim CurrRec As DAO.Recordset

Set CurrDB = CurrentDb
Set CurrRec = CurrDB.OpenRecordset("AIM")

TodayDate = DateTime.Date

StrSQl = "[Start Date] = #" & TodayDate & "#"

CurrRec.FindFirst (StrSQl)

I'm trying to use that FindFirst function to tell me if there is a record that matches my criteria and if not I was going to -1 to TodayDate and check again until I get a record to lock onto.

CodePudding user response：

We create a loop with an an "on error GoTo" which will simply skip the line recording success. We then remove a day from the date variable and try again.

Dim CurrDB As DAO.Database
Dim CurrRec As DAO.Recordset

Set CurrDB = CurrentDb
Set CurrRec = CurrDB.OpenRecordset("AIM")

TodayDate = DateTime.Date
Dim Success as Boolean
Success = false
While (Success = false)
    StrSQl = "[Start Date] = #" & TodayDate & "#"
    On Error GoTo target
    CurrRec.FindFirst (StrSQl)
    Success = true
    target
    TodayDate = DateAdd("d", -1,TodayDate)
Wend

CodePudding user response：

Assuming you have your records sorted by date, use the RecordsetClone:

Private Sub FindDate_Click()

    Dim Records As DAO.Recordset

    Set Records = Me.RecordsetClone

    If Records.RecordCount > 0 Then
        Records.FindFirst "[Start Date] <= Date()"
        If Not Records.NoMatch Then
            Me.Bookmark = Records.Bookmark
            Me![Start Date].SetFocus
        End If
    End If
    Records.Close

End Sub

CodePudding user response：

Get the SQL do the work:

Dim CurrDB As DAO.Database
Dim CurrRec As DAO.Recordset

Set CurrDB = CurrentDb
Set CurrRec = CurrDB.OpenRecordset( _
   "select top 1 [Start Date] from AIM where [Start Date] <= #" & DateTime.Date & "# order by [Start Date] desc")

If CurrRec.EOF Then
   Debug.Print "Not Found"
Else
   Debug.Print CurrRec![Start Date]
End If

CurrRec.Close
Set CurrRec = Nothing
Set CurrDb = Nothing

There is no looping/checking again, etc. Also, when working with objects in VBA, it is good practice to close them (if there is a method for it), and set them to nothing.