I have a table with 3 fields: DONOR_CONTACT_ID, RECIPIENT_CONTACT_ID, ORDER_NUMBER. I want to sort DONOR_CONTACT_ID in ascending order which I did with my query Q_RECIPIENT_SORT. Then I want to use temporary variables to check to see if the records have the same DONOR_CONTACT_ID and then display a message if they do (Most of the records have the same DONOR_CONTACT_ID). My program does everything it is supposed to, but at the end it always gets an error that says "No Current Record". Here is my code:
Option Compare Database
Option Explicit
Function UsingTemps()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strTemp1 As Long
Dim strTemp2 As Long
DoCmd.SetWarnings False
DoCmd.OpenQuery ("Q_RECIPIENT_SORT")
DoCmd.OpenTable ("T_RECIPIENT_SORT")
DoCmd.SetWarnings True
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("T_RECIPIENT_SORT", dbOpenTable)
rst.MoveFirst
strTemp1 = rst!DONOR_CONTACT_ID
rst.MoveNext
strTemp2 = rst!DONOR_CONTACT_ID
Do While Not (rst!DONOR_CONTACT_ID = rst.EOF)
If strTemp1 = strTemp2 Then
MsgBox ("Equal")
Else
MsgBox ("Not equal")
End If
strTemp1 = strTemp2
rst.MoveNext
strTemp2 = rst!DONOR_CONTACT_ID
Loop
Set dbs = Nothing
End Function
I think the problem is with the following lines:
rst.MoveNext
strTemp2 = rst!DONOR_CONTACT_ID
I think it is trying to move to the next record when there are no more records left. Probably something wrong with my logic. But I've been staring at it for a while and my changes haven't worked. I need another set of eyes to take a look at it.
Any help is appreciated!
Consider what happens when your recordset loop is on the last row, and you then do this ...
rst.MoveNext
strTemp2 = rst!DONOR_CONTACT_ID
MoveNext positions the recordset at EOF --- no record is "current". So, in the next line, the code attempts to store the value from the current row's DONOR_CONTACT_ID to strTemp2. However, since you're at EOF, no record is "current", so Access complains "No Current Record".
I think this version will avoid that error. Test the logic to make sure it also does what you need.
rst.MoveFirst
strTemp1 = rst!DONOR_CONTACT_ID
rst.MoveNext
'strTemp2 = rst!DONOR_CONTACT_ID
'Do While Not rst!DONOR_CONTACT_ID = rst.EOF
Do While Not rst.EOF
strTemp2 = rst!DONOR_CONTACT_ID
If strTemp1 = strTemp2 Then
MsgBox "Equal"
Else
MsgBox "Not equal"
End If
strTemp1 = strTemp2
rst.MoveNext
'strTemp2 = rst!DONOR_CONTACT_ID
Loop
The general idea is as this:
Set rst = dbs.OpenRecordset("T_RECIPIENT_SORT", dbOpenDynaset)
Do Until rst.EOF
'do or check what you want
'....
rst.MoveNext
Loop
rst.Close
Related
I am looping through a recordset to carry out some basic functions or edits.
Usually with recordsets with more than 50 records, access will stop responding.
I have me.repaint before the loop command but the window always freezes and the access title bar shows: ...(Not Responding).
Any idea how to get around this?
Thanks.
Dave.
EDIT: Added Loop Code
If Me.Dirty = True Then Me.Dirty = False
Dim rs As DAO.Recordset
Set rs = Me.Guardians_Subform1.Form.Recordset
Dim strFirstName, strLastName As String
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do Until rs.EOF = True
rs.Edit
strFirstName = Trim(StrConv(rs!FirstName, 3))
strLastName = Trim(StrConv(rs!LastName, 3))
If rs!FirstName <> strFirstName Then
rs!FirstName = strFirstName
End If
If rs!LastName <> strLastName Then
rs!LastName = strLastName
End If
rs.Update
rs.MoveNext
Me.Repaint
Loop
Else
MsgBox "There are no records in the recordset."
End If
Set rs = Nothing
You need to call the DoEvents-Function within the loop to pass control to the operating system to redraw your Access-GUI and to process any other Window-Messages that might need processing. By that the application will not be marked as "Not responding" in the Task Manager and the Title Bar.
Do Until rs.EOF = True
[...]
rs.MoveNext
DoEvents
Loop
There is a small performance trade off. If not calling DoEvents, the total execution time for the loop will be a little shorter, but Access will do nothing else then process your loop. Therefore it seems to be not responding.
As others have pointed out you can use the DoEvents to release your processor to do other actions before continuing. When I use the DoEvents in a loop I use a counter.
Dim iCounter as Integer
Do Until
' some code here
iCounter=iCounter+1
If iCounter = 100 then
DoEvents
iCounter=0
End if
Loop
This keeps the DoEvents from firing too often and causing your overall code to slow. Adjust the counter to whatever iteration you find appropriate.
It is not the best approach to do such edits with a recordset loop. An UPDATE query is much more efficient.
e.g.
UPDATE tblGuardians
SET FirstName = Trim(StrConv(FirstName, 3))
WHERE StrComp(FirstName, Trim(StrConv(FirstName, 3)), 0) <> 0
and the same for LastName.
This uses StrComp instead of a simple <> comparison, because the latter is case-insensitive. The third parameter 0 = vbBinaryCompare.
I have a list box in a form. Clicking on it causes the form to jump to another record. It supposed to highlight an item and jump to the correct record. Instead, it highlights, and then instantly clears the selection, although it still jumps to the record. When I use standard record selection buttons, items are correctly highlighted.
I read the index of selected item from .ListIndex property because Selected() does not work in a Single Selection mode when I test which item is selected. However, .ListIndex is read-only property and I use .Selected() to highlight the item.
Option Compare Database
Option Explicit
Private Sub Form_Current()
Call highlightListBox
End Sub
Private Sub lbListBox_Click()
Dim rs As DAO.Recordset
Dim indx As Long
Set rs = Me.RecordsetClone
If Not rs.BOF And Not rs.EOF Then
rs.MoveFirst
rs.FindFirst "[ID]=" & CStr(Me.lbListBox.ItemData(Me.lbListBox.ListIndex))
If Not rs.NoMatch Then
Me.Bookmark = rs.Bookmark
End If
End If
rs.Close
Set rs = Nothing
End Sub
Private Sub highlightListBox()
Dim lngIndx As Long
Dim lngI As Long
Dim bNoMatch As Boolean
lngIndx = 0
bNoMatch = True
If Me.NewRecord <> 0 Or IsNull(Me!ID) Then
For lngI = 0 To Me.lbListBox.ListCount - 1
Me.lbListBox.Selected(lngI) = False
Next lngI
Else
Do
lngIndx = lngIndx + 1
If CLng(Me.lbListBox.ItemData(lngIndx - 1)) = Me!ID Then
bNoMatch = False
End If
Loop Until CLng(Me.lbListBox.ItemData(lngIndx - 1)) = Me!ID Or lngIndx = Me.lbListBox.ListCount
End If
If Not bNoMatch Then
Me.lbListBox.Selected(lngIndx - 1) = True
End If
End Sub
I have been given a suggested about slightly different problem here but thanks to Remou I sorted this out.
The new code is following:
Option Compare Database
Option Explicit
Private Sub Form_Current()
Me.lbListBox = Me!ID
End Sub
Private Sub lbListBox_Click()
Dim rs As DAO.Recordset
Dim indx As Long
Set rs = Me.RecordsetClone
If Not rs.BOF And Not rs.EOF Then
rs.MoveFirst
rs.FindFirst "[ID]=" & CStr(Me.lbListBox.ItemData(Me.lbListBox.ListIndex))
If Not rs.NoMatch Then
Me.Bookmark = rs.Bookmark
End If
End If
Me.lbListBox = Me!ID
rs.Close
Set rs = Nothing
End Sub
I did not realise I could actually set a value to a list box using BoundColumn. By doing so, both highlighting and focusing is set. I am not sure but I think that MultiSelection has to be set to 0. In my case, the line
Me.lbListBox = Me!ID
does the job :)
I hope this answer can help someone else :)
I'm trying to write record set contents to excel sheet. My code is not working when trying to move record set contents to Movefirst. My vba code
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
strSQL = "SELECT * FROM " & qrytable & ""
rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
Set wsSheet1 = wb.Sheets(conSHT_NAME)
wsSheet1.Cells.ClearContents
wsSheet1.Select
For i = 1 To rst.Fields.Count
wsSheet1.Cells(1, i) = rst.Fields(i - 1).Name
Next i
If rst.EOF Then
MsgBox "inside rst"
rst.MoveFirst
wsSheet1.Range("a2").CopyFromRecordset rst
End If
wsSheet1.Columns("A:Q").EntireColumn.AutoFit
rst.Close
The condition If rst.EOF is becomes true and when i'm trying to move record set to rst.Movefirst the debugging control is moving out of the method and moving to the method from where i'm calling this method and not writing contents to excel.
Test for a null recordset with the following:
If (rst.BOF And rst.EOF) Then
rst.Close: set rst = Nothing
Else
rst.MoveFirst
rst.CopyFromRecordset rst
End If
I'm trying to write a piece of code that will run through a table and replace every field that has a certain value with another value.
Private Sub Form_Load()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb()
strSQL = "SELECT Profile3 FROM Bank WHERE 'AB'"
Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)
Do Until rst.EOF
With rst
If .RecordCount > 0 Then
.MoveFirst
.Edit
!Profile3 = "AA"
.Update
.MoveNext
End If
End With
Loop
End Sub
That's what I'm currently using, however, when it runs it crashes horribly. I know the base code works because when I pull out the loop it works, but only on the first entry.
Like most of the issues I seem to have with VBA, it's probably an absurdly simple fix that I am overlooking.
Thank you for your help.
You are constantly moving first. You need to get on at some stage. Just get rid of MoveFirst.
Do Until rst.EOF
With rst
.Edit
!Profile3 = "AA"
.Update
.MoveNext
End With
Loop
In addition, I guess you mean WHERE somefield:
strSQL = "SELECT Profile3 FROM Bank WHERE somefield='AB'"
However, in this case, I suspect what you need is:
strSQL = "UPDATE Bank SET Profile3 ='AA' WHERE Profile3 ='AB'"
CurrentDB.Execute strSQL, dbFailOnError
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.