Option Compare Database
Private rs As Recordset
Private Sub Send_Click()
Dim strLocation As String
If MsgBox("Please confirm you wish to run todays tasks.", vbYesNo) = vbNo Then
Exit Sub
End If
Set rs = Me.RecordsetClone
rs.MoveFirst
Do Until rs.EOF
Debug.Print rs("title")
'Call Update_Progress("Test", rs("ID"))
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End Sub
Hello,
Please see the code above.
Can someone advise how I keep the recordset's position when I move between functions/subs.
This code loops through the records fine if I note out the "Update_Progess" Function but when this is in, it continually loops through the first record?
thanks in advance
As in the Comments,
I had a requery of the form in one of the Functions which was causing the recordset reset its position, this was fixed by amending to a refresh.
Related
I created a listbox and connected it to a table. I wrote the following code to go to record I choose from the listbox. My problem is that when I click on the listbox and code gets to "Me.Bookmark = rst.Bookmark" command (at a break point), the list becomes blank. This is very clear (and ugly) when there is a message to display after this line of code. Any suggestions please?
Private Sub lstFullName_Click()
Dim rst As DAO.Recordset
Set rst = Me.RecordsetClone
rst.FindFirst "sdtID = " & Me.lstFullName.Column(1)
If Not rst.NoMatch Then
Me.Bookmark = rst.Bookmark
End If
Set rst = Nothing
CheckRecordStatus ' Checks for empty fields and gives warnings.
End Sub
I need a code to loop through all the records in a table so I can extract some data. In addition to this, is it also possible to loop through filtered records and, again, extract data? Thanks!
You should be able to do this with a pretty standard DAO recordset loop. You can see some examples at the following links:
http://msdn.microsoft.com/en-us/library/bb243789%28v=office.12%29.aspx
http://www.granite.ab.ca/access/email/recordsetloop.htm
My own standard loop looks something like this:
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Contacts")
'Check to see if the recordset actually contains rows
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst 'Unnecessary in this case, but still a good habit
Do Until rs.EOF = True
'Perform an edit
rs.Edit
rs!VendorYN = True
rs("VendorYN") = True 'The other way to refer to a field
rs.Update
'Save contact name into a variable
sContactName = rs!FirstName & " " & rs!LastName
'Move to the next record. Don't ever forget to do this.
rs.MoveNext
Loop
Else
MsgBox "There are no records in the recordset."
End If
MsgBox "Finished looping through records."
rs.Close 'Close the recordset
Set rs = Nothing 'Clean up
In "References", import DAO 3.6 object reference.
private sub showTableData
dim db as dao.database
dim rs as dao.recordset
set db = currentDb
set rs = db.OpenRecordSet("myTable") 'myTable is a MS-Access table created previously
'populate the table
rs.movelast
rs.movefirst
do while not rs.EOF
debug.print(rs!myField) 'myField is a field name in table myTable
rs.movenext 'press Ctrl+G to see debuG window beneath
loop
msgbox("End of Table")
end sub
You can interate data objects like queries and filtered tables in different ways:
Trhough query:
private sub showQueryData
dim db as dao.database
dim rs as dao.recordset
dim sqlStr as string
sqlStr = "SELECT * FROM customers as c WHERE c.country='Brazil'"
set db = currentDb
set rs = db.openRecordset(sqlStr)
rs.movefirst
do while not rs.EOF
debug.print("cust ID: " & rs!id & " cust name: " & rs!name)
rs.movenext
loop
msgbox("End of customers from Brazil")
end sub
You should also look for "Filter" property of the recordset object to filter only the desired records and then interact with them in the same way (see VB6 Help in MS-Access code window), or create a "QueryDef" object to run a query and use it as a recordset too (a little bit more tricky). Tell me if you want another aproach.
I hope I've helped.
Found a good code with comments explaining each statement.
Code found at - accessallinone
Sub DAOLooping()
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rs As DAO.Recordset
strSQL = "tblTeachers"
'For the purposes of this post, we are simply going to make
'strSQL equal to tblTeachers.
'You could use a full SELECT statement such as:
'SELECT * FROM tblTeachers (this would produce the same result in fact).
'You could also add a Where clause to filter which records are returned:
'SELECT * FROM tblTeachers Where ZIPPostal = '98052'
' (this would return 5 records)
Set rs = CurrentDb.OpenRecordset(strSQL)
'This line of code instantiates the recordset object!!!
'In English, this means that we have opened up a recordset
'and can access its values using the rs variable.
With rs
If Not .BOF And Not .EOF Then
'We don’t know if the recordset has any records,
'so we use this line of code to check. If there are no records
'we won’t execute any code in the if..end if statement.
.MoveLast
.MoveFirst
'It is not necessary to move to the last record and then back
'to the first one but it is good practice to do so.
While (Not .EOF)
'With this code, we are using a while loop to loop
'through the records. If we reach the end of the recordset, .EOF
'will return true and we will exit the while loop.
Debug.Print rs.Fields("teacherID") & " " & rs.Fields("FirstName")
'prints info from fields to the immediate window
.MoveNext
'We need to ensure that we use .MoveNext,
'otherwise we will be stuck in a loop forever…
'(or at least until you press CTRL+Break)
Wend
End If
.close
'Make sure you close the recordset...
End With
ExitSub:
Set rs = Nothing
'..and set it to nothing
Exit Sub
ErrorHandler:
Resume ExitSub
End Sub
Recordsets have two important properties when looping through data, EOF (End-Of-File) and BOF (Beginning-Of-File). Recordsets are like tables and when you loop through one, you are literally moving from record to record in sequence. As you move through the records the EOF property is set to false but after you try and go past the last record, the EOF property becomes true. This works the same in reverse for the BOF property.
These properties let us know when we have reached the limits of a recordset.
The following code is meant to compare a field value PURE_QP1 of a recordset to another field value PURE_QP1 of another second set. But i am getting end of statement expected error. My knowledge of Access vba is admittedly low.
The code is meant to first check if the productcode is present in recordset rst.
if it is, then it checks if it is compliant by finding its PURE_QP1 (which coud be more than 1) in another table. the condition for compliance is such that all its QP1s must be found in the table.
Dim db As DAO.Database
Dim rst As Recordset
Dim rst1 As Recordset
If Nz(Me!Combo_Product_number) <> "" Then
Set db = CurrentDb
Set rst = db.OpenRecordset("Q_compliant_FCM_EU", dbOpenDynaset)
Set rst1 = db.OpenRecordset("T_DOSSIER_FPL", dbOpenDynaset)
Do While Not rst.EOF
If rst.Fields("PRODUCT_CODE") = Me!Combo_Product_number Then
rst1.FindFirst "[PURE_QP1] = '"rst.Fields("PURE_QP1")"'"
If rst.NoMatch Then
MsgBox ("Product code is NOT compliant to FPL")
Exit Sub
End If
rst1.FindNext"[PURE_QP1] = '"rst.Fields("PURE_QP1")"'"
Loop
MsgBox ("Product code is compliant to FPL")
Else
MsgBox ("Product is not available in FCM_EU")
End If
End If
End Sub
Expected end of staement error is showing in
rst1.FindFirst "[PURE_QP1] = '"rst.Fields("PURE_QP1")"'"
and
rst1.FindNext"[PURE_QP1] = '"rst.Fields("PURE_QP1")"'"
You have an extra End If just before End Sub. That End If should go above Loop command to close the If rst.Fields("PRODUCT_CODE") = Me!Combo_Product_number Then if block.
Also your code regarding rst1 is wrong.
rst1.FindFirst "[PURE_QP1] = '"rst.Fields("PURE_QP1")"'"
should be
rst1.FindFirst "[PURE_QP1] = '" & rst.Fields("PURE_QP1") & "'"
the & sign to join strings are missing in your code.
PS: Have no idea what your code supposed to do, because your find first and find next logic seems to be incorrect.
I've seen a number of posts trying to describe this bug but they haven't framed the problem correctly to be reproduced... or not set the scenario in the way that I've experienced the bug using a common technique.
The bug occurs when a form's recordset is set to a virtual recordset and then referred to by a DAO recordsetclone statement. Instead of the recordset being set to the form's recordset (via cloning), a "Select Data Source" dialog is presented.
We most commonly use this to add a checkbox control to a detail form for a user to select one or more records for further processing. I've used this technique many times in many applications but now it fails.
Note: I have confirmed that this code works correctly in Access 2010.
I'm using Windows 10 Pro with a 32 bit Office installation
To set this up and reproduce the bug:
Create a new ACCDB database
Add the following references to the default references:
Microsoft ActiveX Data Objects 6.1 Library
Microsoft ADO Ext. 2.8 for DDL and Security
Create a testing table:
TestId, AutoNumber, PK
TestText, Short Text
Append about 10 rows to the table.
Create an unbound form with 3 controls:
Checkbox, Name: Selected, Control Source: Selected
Textbox, Name: TestId, Control Source: TestId
Textbox, Name: TestText, Control Source: TextText
In the form's header add a command button: Name: cmdTest, Caption: Test
Set the form Default View: Continuous
In the Form_Open call a sub SetRecordsource which creates a recordset and adds a column "Selected" for the user to check the records they want.
The command button cmdTest will attempt to reference the form's recordsource. It's while attempting to reference the form's recordsouce that the error occurs. Instead of the reference being made, the "Select Data Source" dialog pops up.
The complete form's VBA code:
Option Compare Database
Option Explicit
Private Sub cmdTest_Click()
On Error GoTo errHandler
Dim rs As DAO.Recordset
Set rs = Me.RecordsetClone
' Using an ADODB recordset works but is an ugly solution
' To test comment out the Dim DAO and Set rs statements above and uncomment the next 2 lines.
' Dim rs As ADODB.Recordset
' Set rs = Me.Recordset
rs.MoveFirst
With rs
Do While Not .EOF
Debug.Print .Fields("Selected"), .Fields("TestId"), .Fields("TestText")
.MoveNext
Loop
End With
Set rs = Nothing
ExitSub:
Exit Sub
errHandler:
MsgBox "Error in " & Me.Name & ".SetRecordsource " & Err.Number & " - " & Err.Description
Resume ExitSub
End Sub
Private Sub SetRecordsource()
Dim rs As ADODB.Recordset 'the virtual recordset to hold the source data plus the boolean Selected field
Dim rsSource As DAO.Recordset 'dim the source recordset
Set rs = New ADODB.Recordset
With rs
.Fields.Append "Selected", adboolean
.Fields.Append "TestId", adInteger, , adFldKeyColumn
.Fields.Append "TestText", adVarChar, 80
.CursorLocation = adUseClient
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
.Open
Set rsSource = CurrentDb.OpenRecordset("Select TestId, TestText from Test", dbOpenDynaset)
rsSource.MoveFirst
Do Until rsSource.EOF
.AddNew
.Fields("Selected") = 0 'set the checkboxes to unchecked
.Fields("TestId") = rsSource.Fields(0)
.Fields("TestText") = rsSource.Fields(1)
.Update
rsSource.MoveNext
Loop
End With
Set Me.Recordset = rs 'Set the form's recordset = to our virtual recordset
Set rsSource = Nothing
Set rs = Nothing
ExitSub:
Exit Sub
err_handler:
MsgBox "Error in " & Me.Name & ".SetRecordsource " & Err.Number & " - " & Err.Description
Resume ExitSub
End Sub 'SetRecordsource
Open the form and click the Test command button to reproduce the error.
One solution proposed is to use an ADODB recordset and set it to Me.Recordset instead of Me.Recordsetclone. While this does work, it's an ugly solution since you are now operating on the form's recordsource and when looping through the records to find the rows where Selected = True moves the current record on the form. Not only does the current record pointer move but if there's more rows then the can show, the user sees the form's records scrolling.
Any help, confirmation or recommendations would be greatly appreciated.
Thanks in advance!
From another forum the solution to this is to use an ADODB recordset and then clone the form to it via Recordset.Clone. In the code above, it references an "ugly" solution:
' Using an ADODB recordset works but is an ugly solution
' To test comment out the Dim DAO and Set rs statements above and uncomment the next 2 lines.
' Dim rs As ADODB.Recordset
' Set rs = Me.Recordset
Setting rs = Me.Recordset will operate on the form (not desired).
But using an ADODB recordset and then
setting rs = Me.Recordset.Clone works, does not operate on the form and doesn't pop up the Data Source Dialog.
Something has changed in 2016 but this does work and may help someone else.
You may also want to read: Create In-Memory ADO Recordsets at Database Journal
Your code can't work, as you try to assign an ADODB.Recordset (the one in Form.Recordset) to a DAO.Recordset,`as it is declared.
If the Recordset-Type can vary, you can dimrs as Objectthen it gets the type of Form.Recordset(by Form Property RecordsetClone, that surprisingly works for ADODB:Recordsets too). You can query the type with:
If TypeOf Me.RecordSet Is ADODB.Recordset Then
'ADODB
Else
'DAO
End If
If you need an unboundCheckBox, you can useclsCCRecordSelect-Class from SelectRecordsV2.
TheclsCCRecordSelectis used by me for years and I don't want to live without!
When a particular form loads I need to grab a distinct list of locations from a table, with the eventual goal of displaying them to the user (baby steps though, I'll get to that).
The code below generates no error, but when I try to loop through the recordset returned by my query, I get an error in relation to the integer i.
Run-time error '6': Overflow
I've tested the query and it does return the results that I expect, so I believe that my handling of the Recordset object my be the issue.
what am I doing wrong here?
Private Sub Form_load()
Dim DB As DAO.Database
Set DB = CurrentDb ' Set the DB object to use
'**
' Grab a recordset containing distinct locations
'*
Dim RS As DAO.Recordset
Set RS = DB.OpenRecordset( _
"SELECT DISTINCT [Active Directory].[AD Location] FROM [Active Directory]" _
)
Dim i As Integer: i = 0
Dim locations() As String
ReDim locations(0)
'**
' Make an array of the locations to display
'*
If Not (RS.EOF And RS.BOF) Then ' Ensure that the recordset is not empty
RS.MoveFirst ' Move to the first record (unnecessary here, but good practice)
'**
' Loop through the recordset and extract the locations
'*
Do Until RS.EOF = True
locations(i) = RS![AD Location]
i = i + 1
ReDim Preserve locations(i)
Loop
Else
'**
' Tell the user that there are no records to display
'*
Call MsgBox( _
"Sorry, something went wrong and there are no locations to display." & vbCrLf & vbCrLf & _
"Please ensure that the Active Directory table is not empty.", _
vbExclamation, _
"You'd better sit down, it's not good news..." _
)
End If
RS.Close ' Close the recordset
Set RS = Nothing ' Be a hero and destroy the now defunct record set
End Sub
If I'm not missing something, you could just use GetRows:
Dim locations As Variant
RS.MoveLast
i = RS.RecordCount
RS.MoveFirst
locations = RS.GetRows(i)
Thanks to #Arvo who commented that I had forgotten to move to the next record in my do loop.
Adding RS.MoveNext to the loop fixed the problem.
Do Until RS.EOF = True
locations(i) = RS![AD Location]
i = i + 1
ReDim Preserve locations(i)
RS.MoveNext
Loop
You seem to know what you are doing so my question is probably pointless as I'm sure you have a good reason, BUT... why are you stuffing the recordset values into an Array?... Or more specifically how are you displaying the results to the user in the end?
I ask because it would seem to be much simpler to just bind your SQL statement into a control (subform, combobox, listbox etc.) rather than iterating through records like your doing. But, as I said I imagine you have your reasons for doing it that way.