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.
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
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
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.
Related
I have a first table called "BreedingTable" with primary key "ID" and "TransactionStatus" = "Active".
I have "Kidding form" data populated from the combo box to Text fields
Text2.value = "ID" from BreedingTable.
When I am done with all the process, I want to change TransactionStatus of Breeding table = Closed.
I am using the below code but it never works.
Note" if I give exact transaction id number it works fine,
but if I ask to find based on text2 it doesn't work.
My code is as follows:
Private Sub exitprograme3()
Me.Text2.SetFocus
Dim i As Integer
Dim db As Database
Dim rs As Recordset
Dim Trn As Integer
Set db = CurrentDb
Set rs = db.OpenRecordset("BreedingTable")
For i = 0 To rs.RecordCount - 1
Me.Text2.SetFocus
If rs.Fields("ID") = Me.Text2.Value Then
rs.Edit
rs.Fields("BreedingStatus") = "Closed"
rs.Update
End If
rs.MoveNext
Next i
rs.Close
Set rs = Nothing
db.Close
DoCmd.Close
End Sub
Please assist ...
If I type exact transaction id number in below if statement it works
If rs.Fields("ID") = "323" Then
this works fine.
But if I type like below it doesn't work
If rs.Fields("ID") = Me.Text2.Value Then
No loop is needed:
Private Sub exitprograme3()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("Select * From BreedingTable")
rs.FindFirst "[ID] = " & Me!Text2.Value & ""
' If ID is text, then quotes:
' rs.FindFirst "[ID] = '" & Me!Text2.Value & "'"
If Not rs.NoMatch Then
rs.Edit
rs.Fields("BreedingStatus").Value = "Closed"
rs.Update
End If
rs.Close
Set rs = Nothing
Set db = Nothing
DoCmd.Close
End Sub
Hi I have been trying this for hours and it doesn't matter how much I search to try different options I cannot get the lookup for give a result that I am looking for. I am testing it using a date and work code that I know is in the table that I am referring to.
I am using the input box to provide the date and fixing the work code as 13 (Dispatch). The lookup should be returning the date in the table as the date input is in the table. My code is:
Sub Append_Dispatch()
Dim dbs As Object
Dim qdf As querydef
Dim InputDateString As String
Dim InputDate As Date
Dim RtnDate As String
Dim chkDate As Date
Dim WC As Long
Set dbs = CurrentDb
Set qdf = dbs.querydefs("Dispatch Append to Production Data")
WC = 13
InputDateString = InputBox("Please enter start date to import", "Date")
InputDate = DateValue(InputDateString)
RtnDate = DLookup("[Date of Action]", "Production Data", "[Date of Action]= #" & InputDate & "# AND [Work Code] = " & WC & "")
chkDate = DateValue(RtnDate)
If InputDate = chkDate Then
IB = MsgBox("This dispatch date has already been entered:" & vbCrLf & "Please check and use a date after " & Dte, vbOKOnly, "Date Error")
Exit Sub
End If
'qdf.Parameters("Dispatch Date").Value = InputDate
'qdf.Execute
'qdf.Close
'Set qdf = Nothing
'Set dbs = Nothing
End Sub
Also I cannot get the code to work after the end if to input the parameter and run the append query. But that is another issue.
Any ideas please.....
I am checking in the table "weekly data" for a specific date stored in the first row of the table "daily data":
Private Sub Data_Update_Click()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim rstw As DAO.Recordset
Set db = Application.CurrentDb
Set rst = db.OpenRecordset("Data daily", dbOpenDynaset)
Set rstw = db.OpenRecordset("Data Weekly", dbOpenDynaset)
With rst
.MoveFirst
Dim date_check As Date
date_check = DLookup("[ID test]", "Data Weekly", "[weekly date] = '" & .Fields("daily date") & "'")
.........
The criteria is causing the problem, cannot find the right syntax.
Use:
date_check = DLookup("[ID test]", "Data Weekly", "[weekly date] = #" & Format(.Fields("daily date").Value, "yyyy\/mm\/dd") & "#")
but date_check must be a Variant as DLookup can return Null.
I'm trying to read from one access table send an email, "Email1" and then write to the corresponding record "Email2" with the date. To find the corresponding Record, the fields RecID from both tables will match. I keep returning the error that "Syntax Error" highlighting this line below " rs1.Edit where rs!MaxOfForm_Record_Number = rs1.MaxOfForm_Record_Number"
Function EmailTest1()
Dim rs As Recordset
Dim strBody As String
Dim strBody2 As String
Dim strRecipient As String
Dim rs1 As Recordset
Set rs1 = CurrentDb.OpenRecordset("Email2")
Set rs = CurrentDb.OpenRecordset("Email1")
Dim strName As String
Dim strProject As String
Dim strLastDate As String
Dim strNow As String
Dim emailcheck As String
rs.MoveLast
rs.MoveFirst
For i = 1 To rs.RecordCount
If IsNull(rs!EmailStat) = True Then
strNow = Now()
strName = rs!Inspected_By
strProject = rs!Site_Location
strLastDate = rs!LastOfDate_Time_of_Inspection
strBody2 = "BLah blah text "
rs1.Edit where rs!RecID = rs1.RecID
rs1![EmailStat].Value = strNow
rs1.Update
strBody = "blahblah"
strRecipient = rs!Email
DoCmd.SendObject , , , strRecipient, , , "Subject", strBody, False, False
End If
rs.MoveNext
Next i
Set rs = Nothing
End Function
I would not bother with the whole OpenRecordset deal for a simple update, I would just do:
DoCmd.RunSQL "UPDATE Email2 SET EmailStat=#" & strNow & "# WHERE RecID=" & rs!RecID
A additional note:
RecordCount is not exactly trustworthy. I prefer to loop like this:
rs.MoveFirst
Do while Not rs.EOF
{Do Stuff}
rs. MoveNext
Loop
(this does not check for no records at all, to check for no records at all use:
rs.EOF=True AND rs.BOF=true
before rs.MoveFirst, otherwise you will get an error)
You need to find the record - then edit it
You can't do that on one line like you're trying
Replace:
rs1.Edit where rs!RecID = rs1.RecID
With:
rs1.FindFirst "RecID = " & rs!RecID
rs1.Edit
EDIT - add check for NoMatch
NOTE - You should also check for rs1.NoMatch after your FindFirst attempt,
unless you know for sure that there's a RecID match for every record
I've got an Access application that uses a UID for each record, however it does not match up to the record order in SQL. (i.e. my UID of 12845 corresponds to record number 12834 in Access)
I have a search box that I've created that is supposed to search the Access DB and pull up the record that it finds the matching UID, however, the way I've written the code is that it's going to the Record number that matches the UID (so it will goto record number 12845 instead of record 12834 using UID 12845).
I've been sitting on this for a few days and I can't find a way around it. Searching the internet has not proved helpful. IF anyone has an idea for how one can match a string and goto THAT record vs trying to parse the record info myself, then that would be great.
The following is an example of the code I am using. It takes a date string and looks for the string in the records, gets the UID, and then tries to goto the corresponding record:
Private Sub FindBarCodeDate_Click()
Dim Barcode As String
Dim EndDate As String
If IsNull(BarcodeSearch.Value) Then
If IsNull(DateSearch.Value) Then
GoTo Done
Else
EndDate = DateSearch.Value
End If
Else
If IsNull(DateSearch.Value) Then
Barcode = BarcodeSearch.Value
Else
Barcode = BarcodeSearch.Value
EndDate = DateSearch.Value
End If
End If
Dim rs As New ADODB.Recordset
Dim strSql As String
Dim TSD As String
If Barcode <> "" Then
If EndDate <> "" Then
strSql = "SELECT [TSD ID] FROM dbo_barAdultCollectionData WHERE Barcode = '" & Barcode & "' AND [End Date] = '" & EndDate & "'"
On Error GoTo Done
rs.Open strSql, CurrentProject.Connection
TSD = rs.Fields.Item(0)
rs.Close
DoCmd.FindRecord TSD, acEntire, False, acSearchAll, False, acAll, True
Set rs = Nothing
Else
strSql = "SELECT [TSD ID] FROM dbo_barAdultCollectionData WHERE Barcode = '" & Barcode & "'"
On Error GoTo Done
rs.Open strSql, CurrentProject.Connection
TSD = rs.Fields.Item(0)
rs.Close
DoCmd.FindRecord FindWhat:=TSD, Match:=acEntire, MatchCase:=False, Search:=acSearchAll, SearchAsFormatted:=False, OnlyCurrentField:=acAll, FindFirst:=True
Set rs = Nothing
End If
ElseIf Barcode = "" Then
If EndDate <> "" Then
strSql = "SELECT [TSD ID] FROM dbo_barAdultCollectionData WHERE [End Date] = '" & EndDate & "'"
On Error GoTo Done
rs.Open strSql, CurrentProject.Connection
TSD = rs.Fields.Item(0)
rs.Close
DoCmd.FindRecord FindWhat:=TSD, Match:=acEntire, MatchCase:=False, Search:=acSearchAll, SearchAsFormatted:=False, OnlyCurrentField:=acAll, FindFirst:=True
Set rs = Nothing
End If
Else
Done:
SearchError.Caption = "Invalid Search Term!"
End If
End Sub
Thanks!
Don't use DoCmd.FindRecord. Use the technique shown in the second example of Form.RecordsetClone, e.g.
Dim rst As DAO.Recordset
Set rst = Me.RecordsetClone
rst.FindFirst "yourUIDcolumn = '" & TSD & "'"
If rst.NoMatch Then
' This should not happen
MsgBox "Record not found", vbCritical, "Panic!"
Else
' Set current record in form to found record
Me.Bookmark = rst.Bookmark
End If
rst.Close
First, try adding -11 to the UID:
TSD = CStr(Val(rs.Fields.Item(0).Value) - 11)
Also, you need to format your date values as string expressions:
EndDate = Format(DateSearch.Value, "yyyy\/mm\/dd")
and then:
strSql = "SELECT [TSD ID] FROM dbo_barAdultCollectionData WHERE [End Date] = #" & EndDate & "#"