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.
Related
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.
How can I sort the name of the wine in asc order using dbOpenDynaset
Here is my vba code
Dim critère As String
Dim strFormateDesNomVins As String
Dim maBase As Database
Dim tblVins As Recordset
Set maBase = CurrentDb()
Set tblVins = maBase.OpenRecordset("tblVins", dbOpenDynaset)
critère = "[NoTypeVin]=" & typeVin
tblVins.Sort = "NomVin ASC"
tblVins.FindFirst critère
Do Until tblVins.NoMatch
strFormateDesNomVins = strFormateDesNomVins & tblVins!NomVin & vbCrLf
tblVins.FindNext critère
Loop
This part of the code does not work
tblVins.Sort = "NomVin ASC"
I want to sort the name of wine in asc order How can I do this using dbOpenDynaset Thank you for your help.
It works, but you must assign the sorted recordset to a (new) recordset and then use that:
tblVins.Sort = "NomVin ASC"
Set tblVins = tblVins.OpenRecordset()
or:
Set tblVinsSorted = tblVins.OpenRecordset()
or create it sorted initially:
Set tblVins = maBase.OpenRecordset("Select * From tblVins Order By NomVin", dbOpenDynaset)
Rather than trying to use .Sort and .FindFirst/.FindNext, it is better to open a recordset that is already filtered and ordered as you want:
Sub sWine()
Dim db As DAO.Database
Dim rsData As DAO.Recordset
Dim strSQL As String
Dim strFormateDesNomVins As String
Dim typeVin As Long
typeVin = 1
Set db = DBEngine(0)(0)
strSQL = "SELECT NomVin FROM tblVins WHERE NoTypeVin=" & typeVin & " ORDER BY NomVin ASC;"
Set rsData = db.OpenRecordset(strSQL, dbOpenDynaset)
If Not (rsData.BOF And rsData.EOF) Then
Do
strFormateDesNomVins = strFormateDesNomVins & rsData!NomVin & vbCrLf
rsData.MoveNext
Loop Until rsData.EOF
End If
Debug.Print strFormateDesNomVins
rsData.Close
Set rsData = Nothing
Set db = Nothing
End Sub
In the example above, I am creating a recordset that is based on tblVins, sorted by NomVin, and only having records where NoTypeVin is equal to typeVin (in this case 1).
Regards
I have two tables, one (DATES) is a list of 25 dates. The second (RatingsBackDated) is a list of 13,000 names, ratings, IDs and dates. I am trying to create a loop function that goes through and appends the last rating nearest to a date to a table (tblCoDtRtgs). Currently, my code goes through and returns the data from 25 fields, correctly returning the nearest/last data from each of the 25 dates in table DATES. I need it to provide the information for all 13,000. What am I doing wrong?
Thank you!
-J.
Public Function PopulateTableOfRatingHistory()
Dim dbs As DAO.Database
Set dbs = CurrentDb
Dim dtDate As Date 'snapshot date
Dim sqlAppend As String
Dim sqlQueryLastRating As String
Dim qdf As DAO.QueryDef
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Set rs1 = dbs.OpenRecordset("DATES") 'check this to make sure it imports the table values
rs1.MoveFirst
Do While Not rs1.EOF
'get the date value to use as a parameter
dtDate = rs1.Fields(1).Value ' get the date value to lookup
'use the date parameter to run the SQL for the last rating as of the given date
sqlQueryLastRating = "SELECT RatingsBackDated.name, RatingsBackDated.CoID, Last(RatingsBackDated.Rating) AS LastOfRating, Last(RatingsBackDated.Date) AS LastOfDate " & _
"FROM RatingsBackDated " & _
"WHERE (((RatingsBackDated.Date)<= #" & dtDate & "#)) " & _
"GROUP BY RatingsBackDated.name, RatingsBackDated.CoID;"
Debug.Print sqlQueryLastRating
Set rs2 = dbs.OpenRecordset(sqlQueryLastRating)
'append the query result to a table
sqlAppend = "INSERT INTO tblCoDtRtgs ( CoID, SnapDate, Rating, RatingDate ) VALUES (" & rs2.Fields(1) & ", #" & dtDate & "#, " & rs2.Fields(2) & ", #" & rs2.Fields(3) & "#);"
dbs.Execute sqlAppend
rs2.Close
rs1.MoveNext
Loop
rs1.Close
Set rs1 = Nothing
Set rs2 = Nothing
Set dbs = Nothing
End Function
I try to export some data from excel to my access database, but on line 15 rs.open I get the error Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another. I can't seem to figure out what is going wrong here. Any help would be appreciated, thanks!
Public Sub updateAntibiotics(abName As String, Optional startDate As Date, Optional stopDate As Date)
Dim cn As Object, rs As Object
Dim currPath As String, DbPath As String
Dim sProduct As String, sVariety As String, cPrice As Variant
Dim patientID As Integer
' connect to the Access database
currPath = Application.ActiveWorkbook.Path
DbPath = Left$(currPath, InStrRev(currPath, "\")) & "IZ Damiaan.accdb"
Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Data Source='" & DbPath & "';"
' open a recordset
Set rs = CreateObject("ADODB.Recordset")
rs.Open "Antibiotics", cn, adOpenKeyset, adLockOptimistic, adCmdTable
patientID = Val(Sheets("PatientData").Range("A2"))
rs.Filter = "fkPatientID='" & patientID & "' AND Antibiotic='" & abName & "' AND stopDate IS NULL"
If rs.EOF Then
Debug.Print "No existing record - adding new..."
rs.Filter = ""
rs.AddNew
rs("fkPatientID").Value = patientID
rs("Antibiotic").Value = abName
Else
Debug.Print "Existing record found..."
End If
If Not IsNull(startDate) Then rs("startDate").Value = startDate
If Not IsNull(stopDate) Then rs("stopDate").Value = stopDate
rs.Update
Debug.Print "...record update complete."
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
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 & "#"