How to properly finish an access database transaction with DAO vba? - ms-access

I'm working with DAO recorsets, the basic idea is to populate one table with records many times as the given argument indicates (limit).
It appears to work, but suddenly when I want to use the form again, it throws 3022 error. When I see table values, none of them is duplicated. I delete all records from that table and refresh table and form. The table doesn't show any value until I refresh the form. The unique value that is shown is the last value i try to save in database.
Here is a little bit of code:
Private Sub add_element(loops_number As Double)
i = 1
While (i < CDbl(loops_number))
function
i = i + 1
Wend
End Sub
That is working apparently fine.
Private Sub populate()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim last As DAO.Recordset
Set db = CurrentDb()
Set rst = db.OpenRecordset("Element", dbOpenTable)
Set last = rst.Clone
With rst
.AddNew
If (last.RecordCount <= 0) Then
'here I pass input form values to recordset fields ,because its the first row
last.Close
.Update
.Close
Else
last.MoveLast
!Pk = Custom_pk 'Custom_pk is obtained with a function --- not relevant
'here I pass remain values from last record to a new one --- because records has the same attributes
last.Close
.Update
.Close
End If
Set rst = Nothing
Set ultimo = Nothing
End With
End Sub
It's like last record values stays "active" after function finish work. I don't get why this happens.
Element pk is alphanumeric e.g. : "A1", then I build a function that separates A from 1,add +1 to number and concatenate values again, so the result is "A2"

I resolved it using an Autonumber field as primary key keeping the original pk (alphanumeric) as a common field then I could mantain my vba code exactly like I wanted it.

Related

Store table as recordset of Dynaset type

I am passing a table in the current database to a recordset with 2 dimensions. Currently:
Public Sub MySub(obj As Variant)
Dim dbs As DAO.Database
Dim tbl As DAO.Recordset
Set dbs = CurrentDb
Set tbl = dbs.OpenRecordset("TABLE")
tbl.MoveLast
Records = tbl.GetRows(tbl.RecordCount)
Stop
...
End Sub
Stepping through in my locals window (and checking in the immediate window), I can see that the tbl.RecordCount = 1074 but Records is still only getting the active record with all of the fields, i.e. Records Type is Variant(0 to 37, 0 to 0).
I am able to execute a similar approach when storing a query. I have also tried the syntax:
Set tbl = dbs.OpenRecordset("TABLE",dbOpenDynaset)
And
Set tbl = dbs.OpenRecordset("TABLE",dbOpenTable)
The former had the same issue, and the latter returned Run-time error '3219'.
Edit: example of GetRows with Query (see comments)
Set dbs = CurrentDb
Set rsQuery = dbs.OpenRecordset("QUERY", dbOpenDynaset)
varRecords = rsQuery.GetRows(rsQuery.RecordCount)
If you had read the GetRows Docs, you would have recognized, thatGetRowsreturns records from the actual cursor position and moves the cursor to the next not retrieved row (like.Move).
As you move the cursor to the last record(tbl.MoveLast), no more records are remaining to get.
Solution:
Just move the cursor to the beginning of the Recordset and everything is fine
tbl.MoveLast
tbl.MoveFirst
Records = tbl.GetRows(tbl.RecordCount)
dbOpenTable raises error 3219, if opened table is not local and .OpenRecordset("TABLE",dbOpenDynaset)is equal to .OpenRecordset("TABLE")asdbOpenDynasetis the default value, for non-local tables. (Docs reveal that too ;)

Setting the value of an Access combobox with VBA comparison

I'm trying to figure out where I went wrong with this.
I have two tables Request and Parent. Request can only have one related Parent record, but Parent can have many related Request records. So I have the Request table containing the foreign key to Parent.
I have an unbound combobox that pulls it's data from the Parent table using a query (contains company name and ID bound to column 0 and 1, with column 1 being hidden so the user doesn't see the numeric ID). It's unbound because the form's recordset has a lot of complex joins, making anything on that form unable to be updated. So I created an "On Change" event on the combo box to fill in the foreign key using a querydef SQL update query:
Private Sub Combo217_Change()
Dim ComboID As String
Dim ReqID As Long
Dim dbs As DAO.Database
Dim qdfUpdateParentExisting As DAO.QueryDef
ReqID = Me.RequestID.Value
ComboID = Me.Combo217.Column(1)
Set dbs = CurrentDb
Set qdfUpdateParentExisting = dbs.QueryDefs("UpdateReqExistingParent")
qdfUpdateParentExisting.Parameters("VBParent").Value = ComboID
qdfUpdateParentExisting.Parameters("VBReqID").Value = ReqID
qdfUpdateParentExisting.Execute
qdfUpdateParentExisting.Close
DoCmd.Save acForm, "DT2"
Me.Requery
End Sub
This works just fine, but once you exit the form and re-enter it, the value in the combo box is blank and I would like this to contain the same value that was selected.
I've been trying to do an "On load event" with the following code but it's not working
Dim ParID
ParID = Me.ParentID.Value
Me.Combo217.Column(1).Value = ParID
Any input on getting this to work would be fantastic!
Because it's tied to specific column you can loop thru to set the value based on the matching ID
EDIT - Add Row index to Column Value
Dim i as Integer
With Combo217
For i = 0 To .ListCount - 1
If .Column(1, i).Value = ParID Then
.Value = .ItemData(i)
Exit For
End If
Next
End With

Why isn't MS Access "item found in collection?"

I have a non-linked table "tblGrantRptData" in which I am trying to modify field records for subsequent filtering and export to EXCEL. I have ensured that all field names are correctly spelled, yet I still get an Error 3265, Item not found in this collection.
I have confirmed that MemmonthlyIncome is the correct spelling and is identified in the design as "currency."
here is the design veiw that appears to show the field name:
It stops at this line:
If IsNull (!MemmonthlyIncome) Then
with the error 3265
If I can get some help to resolve this, I would then like to store the range "0-30"....
One suggestion below was to “decompile" and "recompile.” I have read that this may cause problems when the database is used on multiple workstations. I have revised the code to just get to first base….Any suggestions?
Private Sub cmdGenerateGrantRpt_Click()
'now run the qqAll query - this generates the tblGrantRptData - then close the query
DoCmd.SetWarnings False
DoCmd.OpenQuery "qqAll", acViewNormal, acEdit
DoCmd.Close acQuery, "qqAll"
DoCmd.SetWarnings True
'First set up the table: tblGrantRptData with the correct data in fields
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("tblGrantRptData", dbOpenTable)
'Check to see if the recordset actually contains rows and fill in particular values
With rs
If .EOF And .BOF Then
MsgBox "There are no records in this time interval"
Exit Sub
Else
.MoveFirst
Do Until .EOF = True
'Replace the monthly income with income categories
If IsNull(!MemmonthlyIncome) Then
.Edit
!MemmonthlyIncome = "0-30"
.Update
End If
Loop
End If
End With
rs.Close 'Close the recordset
Set rs = Nothing 'Clean up
End Sub
You get error #3265, "Item not found in this collection", at IsNull(!MemmonthlyIncome) in this context ...
Set rs = db.OpenRecordset("tblGrantRptData", dbOpenTable)
With rs
If IsNull(!MemmonthlyIncome) Then
That would happen if tblGrantRptData does not include a field named MemmonthlyIncome. What you are seeing as the column heading in the table Datasheet View may be the field's Caption property. You could check the field's Name and Caption properties in the table's Design View. Or you could list the actual field names for your table in the Immediate window.
Here's an abbreviated list of the field names in my Contacts table:
set db = currentdb
for each fld in db.TableDefs("Contacts").Fields : ? fld.name : next
ID
Company
Last Name
First Name
You just added this screen capture of your table in Design View ...
Notice the field is named MemmothlyIncome, not MemmonthlyIncome (moth vs. month). So it wasn't a Name vs. Caption difference after all; you simply tried to use a misspelled field name. That spelling problem is also visible in the DataSheet View screen capture, but we didn't notice it there.
In VBA, there is no Is Null expression as there is in SQL. Change to IsNull(rs!MemmonthlyIncome).
Possibly, Null is being referenced in recordset collection and hence returning the error.

insert data to a record already saved to a table

I have a recordset that is missing one field for each record and would like to add some data from a form by looking up certain criteria. I used a select query to get data onto the form in the first place and tried to reverse the assigning of values but it doesnt work as it says Run-time error 3027 'the Database or Object is Read only.' I think this is because I ran a select query to get the information but how do I input the data to the same records. the code I used is below -
Private Sub CmdAppend_Click()
Dim dbsNorthwind As dao.Database
Dim rstAmend As dao.Recordset
Dim qdfAmend As dao.QueryDef
Dim n As Integer
Set dbsNorthwind = CurrentDb
Set qdfAmend = dbsNorthwind.QueryDefs("Get_Questions_NTL")
qdfAmend.Parameters(0) = [Forms]![TeamLeader]![ComClientNotFin]
qdfAmend.Parameters(1) = [Forms]![TeamLeader]![ComDateSelect]
Set rstAmend = qdfAmend.OpenRecordset(dbOpenDynaset)
n = 0
rstAmend.MoveFirst
Do Until rstAmend.EOF
n = n + 1
rstAmend.Fields("ManagerID") = Form.Controls("SC" & n).Value
rstAmend.MoveNext
Loop
End Sub
You'd have to use the .Edit and .Update methods of the recordset object to update records. You received the error because you are trying to assign a value to a read only property.

Round Robin Records in Access VBA

I am attempting to round-robin names into a "TASK" column depending on which type of job is assigned in the "JOB" column. My table looks like this for example:
my code is as follows:
Sub macro2()
Dim Rst As DAO.Recordset
Set Rst = CurrentDb.OpenRecordset("table1")
Dim employee(2) As String
employee(0) = "empname1"
employee(1) = "empname2"
Dim i As Integer
With Rst
i = 0
Rst.MoveFirst
Do While Not .EOF
If Rst.Fields("JOB") = "LETTER" Then
Rst.Edit
Rst.Fields("Task").value = employee(i)
Rst.Update
End If
.MoveNext
i = i + 1
If i > 2 Then i = 0
Loop
End With
DoCmd.Requery
End Sub
The problem is, sometimes it "misses" an assignment, and I am not sure why.
It should have kept looping those 2 names into the column, but it wont. However, sometimes after running it a couple of times it will do it. Upon opening the DB fresh, it will not, and will appear as above after completing. Any ideas?
This piece of the code allows i to have a value of 2.
i = i + 1
If i > 2 Then i = 0
But UBound(employee) is 1, which means employee(i) should throw a "subscript out of range" error when i is 2. But you didn't report getting that error, so I don't understand what's going on.
Also your first screenshot shows "Letter" and "Change" in the Job column, but the second screenshot shows all as "Letter". That's another puzzler.
Maybe you need to load the recordset with a query rather than the full table.
Set Rst = CurrentDb.OpenRecordset("SELECT Job, Task FROM table1 " & _
"WHERE Job = 'Letter'")
Then as you move through the recordset rows, toggle i between 0 and 1.
i = IIf(i = 1, 0, 1)
It looks to me like those changes might allow your code to work as you intend. However consider an approach which is more flexible and easier to maintain. Store the employee names in a table and open a second recordset, rsEmployees, to hold those employee names. As you move through the first recordset, Rst, also advance the second: rsEmployees.MoveNext If you reach rsEmployees.EOF, do rsEmployees.MoveFirst That should "round robin" the assignments.
That approach would allow you to add/remove employees from the available pool by simply updating the employees table. You wouldn't need to revise your VBA code each time you add/remove employees.