The 1st record in the open order table matches a record in the Bookings table but the NO MATCH = True is happening and therefore it goes down thru the code anf tries to insert a new record. This is true for several records in the file and it tries to add the record even though there is a match. If I set the NO MATCH = False then it does the else. I imported these table from Access 97 to 2010 where it is working correctly. Any help would be appreciated.
Additional note: While in Debug, If I hover the mouse over the .Seek "=", TempCust, TempPart fields, it shows the 1st record in the table and that data is in the Bookings table. Not understanding why it is not matching?
Sub Get_Current_Info()
DoCmd.SetWarnings False
Dim rstOpenOrd, rstBookings As Recordset
Dim TempCust, TempPart, TempQty, TempDollars As Variant
Set rstOpenOrd = CurrentDb.OpenRecordset("Open Orders", dbOpenTable)
Set rstBookings = CurrentDb.OpenRecordset("Bookings", dbOpenTable)
'Get the open orders
Do While Not rstOpenOrd.EOF
With rstOpenOrd
TempCust = !ODCSNO
TempPart = !ODITNO
TempQty = !ODQTOR
TempDollars = !OrdDollars
End With
With rstBookings
.Index = "PrimaryKey"
.Seek "=", TempCust, TempPart
If rstBookings.NoMatch = True Then
With rstBookings
.AddNew
!cusno = TempCust
!PrdNo = TempPart
!Qty_booked = TempQty
!Dol_booked = TempDollars
!Yest_qty_booked = 0
!Yest_dol_booked = 0
!Shipped_qty = 0
!Shipped_dol = 0
.Update
End With
Else
With rstBookings
.Edit
!Qty_booked = !Qty_booked + TempQty
!Dol_booked = !Dol_booked + TempDollars
.Update
End With
End If
End With
rstOpenOrd.MoveNext
Loop
End Sub
This line suppresses information, including many types of error information ...
DoCmd.SetWarnings False
I don't see why you would want it at all in this procedure. But, at least during troubleshooting, make sure SetWarnings is on ...
'DoCmd.SetWarnings False
DoCmd.SetWarnings True
The point is that you need every possible tidbit of information you can get while troubleshooting. Don't suppress any of it.
The code would not do what you expect if the Bookings table does not include an index named PrimaryKey, or if that index does not include cusno and PrdNo (in that order) as its first 2 keys.
But that is just speculation. You need to test with SetWarnings on and see whether Access gives you useful details.
You must dim your variables or they are just Variant/Object:
Dim rstOpenOrd As DAO.Recordset
Dim rstBookings As DAO.Recordset
Related
I fetch a recordset
Do while not recset.eof
Recset.movenext
Loop
and want to set the current record of the recordset to an other recordset with vba
Set rec2 = rec1.????
I tried
Set.Rec2 = recset.bookmark
But no success!
I hope there is a way to set the current record to an other recordset easely
Thanks for your help
There are numerous options, but without knowing your exact goal it's hard to know which one is best for you.
One option is opening up a recordsetclone:
Set rec2 = rec1.RecordsetClone 'Open a clone
rec2.Bookmark = rec1.Bookmark 'Move the clone to the same record
In that case, rec2 contains all data rec1 has, but is set to the same record.
Another option is using a filter:
rec1.Filter = "ID = " & rec1!ID 'Set a filter to the current record, assumes ID = primary key
Set rec2 = rec1.OpenRecordset 'Set rec2 to the filtered result, rec1 is still unfiltered
My goal was export the current record of a recordset to Excel file. As written by Eric, it's impossible to set the current record to another recordset.
But copyFromRecordset has very interesting properties for solve my issue as you can see below
CopyFromRecordset RecordSet , MaxRows , MaxColumns Full description here
So I tested this code and It works great
Dim oRecSet As Recordset, oRecSetClone As Recordset
Dim varBookmark As Variant
Set objExcelApp = New Excel.Application
objExcelApp.Visible = True
Set wb = objExcelApp.Workbooks.Open("G:\Access\test.xlsx")
Set ws = wb.Sheets(1)
sSQL = "SELECT * FROM tbl"
Set oRecSet = CurrentDb.OpenRecordset(sSQL)
Set oRecSetClone = oRecSet.Clone
Do While Not oRecSet.EOF
Debug.Print i
oRecSetClone.Bookmark = oRecSet.Bookmark
ws.Range("A" & i).CopyFromRecordset oRecSetClone, 1
oRecSet.MoveNext
Loop
End Sub
Just one comment
I use bookmark because I noticed a strange behaviour when I Apply copyFromRecordSet rec,1.
After this command, rec.movenext generates an error message: Nbr 3021 - No current record
I have a saved query, qryInsertLog which is as follows:
PARAMETERS UserIDPar Long, UnitIDPar Long, LogEntryPar LongText, FNotesPar LongText;
INSERT INTO tblLogBook ( UserID, UnitID, LogEntry, FNotes )
SELECT [UserIDPar] AS Expr1, [UnitIDPar] AS Expr2, [LogEntryPar] AS Expr3, [FNotesPar] AS Expr4;
I'm trying to run this query when a save button is clicked on an unbound form, where the parameters are gathered from the form controls. My VBA code for the save button is:
Private Sub cmdSave_Click()
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim okToSave As Boolean
If Me.cboUser.Value = 0 Or IsNull(Me.cboUser.Value) Then
MsgBox "You must choose a user. Record not saved."
okToSave = False
ElseIf Me.cboUnit.Value = 0 Or IsNull(Me.cboUnit.Value) Then
MsgBox "You must choose a unit. Record not saved."
okToSave = False
ElseIf Me.txtLogEntry.Value = "" Or IsNull(Me.txtLogEntry.Value) Then
MsgBox "You must have somtehing to log. Record not saved."
okToSave = False
Else
okToSave = True
End If
Set db = CurrentDb
Set qdf = db.QueryDefs("qryInsertLog")
qdf.Parameters("UserIDPar").Value = Me.cboUser.Value
qdf.Parameters("UnitIDPar").Value = Me.cboUnit.Value
qdf.Parameters("LogEntryPar").Value = Me.txtLogEntry.Value
qdf.Parameters("FNotesPar").Value = IIf(IsNull(Me.txtFNotes.Value), "", Me.txtFNotes.Value)
If okToSave Then
qdf.Execute
End If
qdf.Close
Set qdf = Nothing
End Sub
When this code is run, the FNotes field of the table isn't updated. The other three fields update as expected. FNotes is the only field which isn't required. I hardcoded a string for FNotes paramater like so:
qdf.Parameters("FNotesPar").Value = "why doesn't this work"
rather than using the form control value, and got the same result: that field just doesn't update. When I run this query from the Access Objects window and supply parameter values from the prompts, it works just fine. When I create form that's bound to the table, it also seems to work just fine.
I can't figure out why there's no trouble updating the LogEntry field but the FNotes field fails to update.
Add the new record via a DAO.Recordset instead of a DAO.QueryDef.
First, include this declaration ...
Dim rs As DAO.Recordset
Then use this after Set db = CurrentDb ....
Set rs = db.OpenRecordset("tblLogBook")
With rs
If okToSave Then
.AddNew
!UserID = Me.cboUser.Value
!UnitID = Me.cboUnit.Value
!LogEntry = Me.txtLogEntry.Value
!FNotes = Nz(Me.txtFNotes.Value, "")
.Update
End If
.Close
End With
Note Nz(Me.txtFNotes.Value, "") gives you the same thing as IIf(IsNull(Me.txtFNotes.Value), "", Me.txtFNotes.Value), but more concisely.
I have a crosstab query that is being loaded into a recordset. I'm then writing the query fields to an Excel spreadsheet. The problem is that a field may not exist based on the query results.
For example, I have the following line:
oSheet5.Range("F1").Value = rsB2("AK")
...which would write the value of the recordset item named "AK" to the spreadsheet. But if "AK" doesn't exist, I get an error Item not found in this collection.
How I can I test to see if there's an item named "AK"?
I tried...
If rsB2("AK") Then
oSheet5.Range("F" & Count).Value = rsB2("AK")
End If
...but that didn't work.
I also tried...
If rsB2("AK") Is Nothing Then
oSheet5.Range("F" & Count).Value = ""
Else
oSheet5.Range("F" & Count).Value = rsB2("AK")
End If
...and still the same error.
There are 50+ items/fields to check .. all states in USA plus a few extras.
Thanks!
You can use Recordset.FindFirst Method (DAO) take a look here or here
Small example:
Sub FindOrgName()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
'Get the database and Recordset
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblCustomers")
'Search for the first matching record
rst.FindFirst "[OrgName] LIKE '*parts*'"
'Check the result
If rst.NoMatch Then
MsgBox "Record not found."
GotTo Cleanup
Else
Do While Not rst.NoMatch
MsgBox "Customer name: " & rst!CustName
rst.FindNext "[OrgName] LIKE '*parts*'"
Loop
'Search for the next matching record
rst.FindNext "[OrgName] LIKE '*parts*'"
End If
Cleanup:
rst.Close
Set rst = Nothing
Set dbs = Nothing
End Sub
You could add an error handler to catch the item not found error ... ignore it and/or do something else instead.
Or if the first recordset field always maps to the first sheet column regardless of the field's name, you can reference it by its ordinal position: rsB2(0)
Or you could examine the recordset's Fields collection to confirm the field name is present before attempting to retrieve its value.
After you open the recordset, load a dictionary with its field names. This code sample uses late binding. I included comment hints in case you want early binding. Early binding requires you to set a reference for Microsoft Scripting Runtime.
Dim objDict As Object 'Scripting.Dictionary
'Set objDict = New Scripting.Dictionary
Set objDict = CreateObject("Scripting.Dictionary")
Dim fld As DAO.Field
For Each fld In rsB2.Fields
objDict.Add fld.Name, vbNullString
Next
Then later you can use the dictionary's Exists method to your advantage.
If objdict.Exists("AK") = True Then
oSheet5.Range("F1").Value = rsB2("AK")
End If
I inherited an MS Access database at my office that is heavily used by several people over the network. This causes many issues with data collisions and locks. I want to split the db so that each user has thier own front-end app and maintain the core data on the server.
Several of the tables use an autonumber:sequence:long as thier primary key - in researching how to perform the split I've come across several posts that hint this can cause issues when distributing a database but I haven't been able to find anything solid. The issue seems to be that a user can begin a new record and receive the next autonumber but a second user can create a new record within a short interval and receive the same autonumber resulting in an error?
Does Jet handle this correctly or are there autonumber issues with a FE/BE database? If it's an unlikely-but-possile occurance I'm sure it will still be much better than what my users are currently experiencing but I'd like to know if there are ways I can minimize such issues.
Thanks for your help!
I've had the misfortune of working with many Access databases in my youth. While there are many issues with Access, I do not know if I've ever run into a problem with AutoNumber columns in a split database, multi-user environment. It should work fine. This is such a common setup that there would be posts all over the Internet about it if were an issue.
As long as you are not going for data replication (ie multiple subscriber databases, where users can insert new records in same tables but in different locations), you will not have problems with autonumbers as primary keys.
If you think that one of these days you might need to go for replication (different locations, one central database), do not hesitate to switch to unique identifiers (replication IDs).
There seems to be some confusion on your part about the process of splitting. When you do so, you end up with multiple front ends, but the back end is still a single file. Thus, there's no difference at all for the data tables in terms of Autonumbers from what you had before you split the application.
I had the same problem, nevertheless i did a workarround to get the autonumbering work from an Onload() Event
What I did is :
I create a recordset based on Your_Table everytime the user needs an autonumber
Open the recordset (rst)
Search if:
-Your_Table is Empty, then assigns the value "1" to Your_field
-Your_Table is has data without missing numbers,then assigns the value = "Count of lines + 1" to Your_field (1,2,....,n+1)
-Your_Table has missing data (1,3,4,5,7) [Note "#2 and #7 are missing]", then uses a function to search in Your_Table the missing fields and assign to Your_Field the first missing value (#2 in this example)
Private Sub Autonumbering(Your_Table As String)
Dim rst As DAO.Recordset
Dim db As Database
On Error GoTo ErrorHandler
Application.Echo False
Set db = CurrentDb
Set rst = db.OpenRecordset(Your_Table, dbOpenDynaset)
With rst
.AddNew
'Your_Table is Empty, **then** assigns the value "1" to Your_field
If DMin("[Your_Field]", Your_Table) = 1 Then
'Your_Table is has data without missing numbers,**then** assigns the value = "Count of lines + 1" to Your_field (1,2,....,n+1)
If DMax("[Your_Field]", Your_Table) = .RecordCount Then
'Assings n+1 value to [Your_Field] records
Value = .RecordCount + 1
![Your_Field] = Valor
Else
'Your_Table has missing data (1,3,4,5,7) [Note "#2 and #7 are missing]", **then** uses a function to search in Your_Table & _
the missing fields and assign to Your_Field the first missing value (#2 in this example)
Value = MyFunction$(Your_Table, "Your_Field")
![Your_Field] = Value
End If
Else
'Agrega el número 1
Value = 1
![Your_Field] = Value
End If
.Update
.Bookmark = .LastModified
Me.Requery
DoCmd.GoToRecord acDataForm, Me.Name, acGoTo, Value
.Move 0, .LastModified
End With
ErrorCorregido:
Application.Echo True
Exit Sub
ErrorHandler:
MsgBox "An error ocurred, please verify numbering", vbCritical + vbOKOnly
Resume ErrorCorregido
End Sub
Here is the function that i found to get the missing values on an specific table, i cant find it anymore, but thanks for the one who made it.
Function MyFunction$(cstrTable As String, cstrField As String)
' Read table/query sequentially to record all missing IDs.
' Fill a ListBox to display to found IDs.
' A reference to Microsoft DAO must be present.
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim lst As ListBox
Dim Col As Collection
Dim strSQL As String
Dim strList As String
Dim lngLast As Long
Dim lngNext As Long
Dim lngMiss As Long
' Build SQL string which sorts the ID field.
strSQL = "Select " & cstrField & "" _
& " From " & cstrTable & " Order By 1;"
Set Col = Nothing
' Control to fill with missing numbers.
'Set lst = Me!lstMissing
' Collection to hold the missing IDs.
Set Col = New Collection
'// Vacía la colección
'Erase Col
' Read the table.
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strSQL)
If rst.RecordCount = 0 Then
' The recordset is empty.
' Nothing to do.
Else
' Read and save the ID of the first record.
lngLast = rst(cstrField).value
rst.MoveNext
' Loop from the second record through the recordset
' while reading each ID.
While rst.EOF = False
lngNext = rst(cstrField).value
' For each ID, fill the collection with the
' missing IDs between the last ID and this ID.
For lngMiss = lngLast + 1 To lngNext - 1
Col.Add (lngMiss)
Next
' Save the last read ID and move on.
lngLast = lngNext
rst.MoveNext
Wend
' Finally, add the next possible ID to use.
Col.Add (lngLast + 1)
End If
rst.Close
For lngMiss = 1 To Col.Count
' Build the value list for the ListBox.
If Len(strList) > 0 Then
' Append separator.
strList = strList & ";"
End If
' Append next item from the collection.
strList = strList & Col(lngMiss)
' For debugging only. May be removed.
Debug.Print Col(lngMiss)
Next
' Pass the value list to the ListBox.
' Doing so will requery it too.
' lst.RowSource = strList
' For debugging only. May be removed.
' Debug.Print strList
MyFunction$ = Col(1)
' Clean up.
Set rst = Nothing
Set dbs = Nothing
Set Col = Nothing
Set lst = Nothing
End Function
set recordsetname = databasename.openrecordset(SQLString)
if recordsetname.bof <> true and recordsetname.eof <> true then
'do something
end if
2 questions :
the above test can evaluate to false incorrectly but only extremely rarely
(I've had one lurking in my code and it failed today, I believe for the first time in 5 years of daily use-that's how I found it). Why very occasionally will one of bof/eof be true for a non-empty recordset. It seems so rare that I wonder why it occurs at all.
Is this a foolproof replacement:
if recordsetname.bof <> true or recordsetname.eof <> true then
Edit to add details of code :
Customers have orders, each order begins with a BeginOrder item and end with an EndOrder item and in between are the items in the order.
The SQL is:
' ids are autoincrement long integers '
SQLString = "select * from Orders where type = OrderBegin or type = OrderEnd"
Dim OrderOpen as Boolean
OrderOpen = False
Set rs = db.Openrecordset(SQLString)
If rs.bof <> True And rs.eof <> True Then
myrec.movelast
If rs.fields("type").value = BeginOrder Then
OrderOpen = True
End If
End If
If OrderOpen F False Then
'code here to add new BeginOrder Item to Orders table '
End If
ShowOrderHistory 'displays the customer's Order history '
In this case which looks this this
BeginOrder
Item a
Item b
...
Item n
EndOrder
BeginOrder
Item a
Item b
...
Item n
EndOrder
BeginOrder
Item a
item b
...
Item m
BeginOrder <----should not be there as previous order still open
The documentation clearly states that, if you open a Recordset that has no records:
BOF will be true
EOF will be true
RecordCount will be 0
For a non-empty Recordset, neither BOF and EOF are true until you move beyond the first or last record.
Could it be that, from time to time, someone else could have added/deleted a record to one of the tables in the recordset you're just opening and change the resultset?
It could be the result of a race condition.
Rather than use BOF or EOF, you can test on Recordcount: it's always 0 if the recordset is empty.
If the recordset is not empty, it will usually return 1 right after the recordset has been open; Recordcount isn't an expensive operation in that case.
The only way to really return the actual number of records is to issue a MoveLast before calling Recordcount to force all records to be loaded.
Usually, if I need to iterate through a resultset in read-only fashion:
Dim db as DAO.Database
Dim rs as DAO.RecordSet
Set db = CurrentDB()
Set rs = db.OpenRecordSet("...", dbOpenForwardOnly)
If Not (rs Is Nothing) Then
With rs
Do While Not .EOF
' Do stuff '
.MoveNext
Loop
.Close
End With
Set rs = Nothing
End If
Set db = Nothing
If I don't need to iterate through records but just test if anything was returned:
Set rs = db.OpenRecordSet("...", dbOpenForwardOnly)
If Not (rs Is Nothing) Then
With rs
If .RecordCount > 0 Then
' We have a result '
Else
' Empty resultset '
End If
.Close
End With
Set rs = Nothing
End If
Set db = Nothing
It's pretty defensive and you have to adapt to your circumstances, but it works correctly every time.
Regarding your 2nd question, testing (BOF Or EOF) after opening the recordset should be more foolproof than the And version, although I'd use Recordcount myself.
Edit following your revised question:
From the bit of code you added to your question, I see a couple of issues, the main one being that your SQL Statement is missing and ORDER BY clause.
The problem is that you are expecting the resultset to be in the Begin Order followed by End Order sequence but your SQL Statement doesn't guarantee you that.
In most cases, since you're using an autoincrement as ID, the database engine will return the data in that natural order, but there is no guarantee that:
It's always going to happen that way
That the original data was saved in the expected sequence, resulting in IDs that are in the 'wrong' order.
So, whenever you have expectations about the sequence of the resultset, you must explicitly order it.
I would also refactor this bit of code:
' ids are autoincrement long integers '
SQLString = "select * from Orders where type = OrderBegin or type = OrderEnd"
Dim OrderOpen as Boolean
OrderOpen = False
Set rs = db.Openrecordset(SQLString)
If rs.bof <> True And rs.eof <> True Then
myrec.movelast
If rs.fields("type").value = BeginOrder Then
OrderOpen = True
End If
End If
Into a separate function similar to:
' Returns true if the given CustID has a Open Order, '
' false if they are all closed.'
Public Function IsOrderOpen(CustID as Long) As Boolean
Dim result as Boolean
result = False
Dim sql as String
' Here I assume that the Orders table has a OrderDateTime field that '
' allows us to sort the order in the proper chronological sequence '
' To avoid loading the complete recordset, we sort the results in a way '
' that will return the last used order type as the first record.'
sql = sql & "SELECT Type "
sql = sql & "FROM Orders "
sql = sql & "WHERE ((type = OrderBegin) OR (type = OrderEnd)) "
sql = sql & " AND (CustID=" & CustID & ")"
sql = sql & "ORDER BY OrderDateTime DESC, Type DESC;"
Dim db as DAO.Database
Dim rs as DAO.Recordset
Set db = CurrentDB()
Set rs = db.Openrecordset(sql, dbOpenForwardOnly)
If Not (rs Is Nothing) Then
If rs.RecordCount > 0 Then
result = (rs!type = BeginOrder)
End If
rs.Close
End If
Set rs = Nothing
Set db = Nothing
IsOrderOpen = result
End Function
This would make the whole thing a bit more robust.
The pattern I have always used is:
Set rs = db.OpenRecordset(...)
Do while Not rs.EOF
' Rest of your code here.
rs.MoveNext
Loop
I have never seen this fail (yet!). This is described here: How to: Detect the Limits of a DAO Recordset
As an aside, Allen Browne's VBA Traps: Working with Recordsets might be of interest.
#Renaud Bompuis's answer is quite good. Let me emphasize the point that the DAO Recordcount is never zero for a non-empty recordset, and that is the only thing I ever test in determining if a recordset has returned records. I use .EOF for looping through the records, but don't start stepping through the records until I've already tested if there are records returned.
This is DAO, right? I'm more an ADO man myself but IIRC there are circumstances (dynaset?) where you need to navigate EOF in order for the final number of rows to be assessed. Could it be in this state that EOF is true, BOF is false (because it hasn't been navigated yet) but as soon as BOF is navigated it is true (obviously) and EOF remains true. Presumably the initial state when zero rows are expected is supposed to be instantaneous but a once-in-five-years freak timing incident means you captured it in a really early initial state?
I occasionally come across the exact same bug in access (had it today in Access 2007 linked to a sql server back end) where the statement
if rst.bof and rst.eof
evaluates to false despite rst representing an empty recordset. When it happened, VBA started and the debugger in the immediate pane showed that, indeed rst.bof was true and rst.eof was true, so it seems to happen for a millisecond and then is corrected, but after one has tested the logic.
Here's a possible solution
It could be that your form or module has gotten corrupted. Export/Import the affected module or form, or try the /decompile option. In my case a query was coming back empty when it shouldn't have, but I think the core problem could be similar.