VBA on click_ delete records of a table - vba

I am trying to delete the records of a table rather than deleting the records of a form. I have the following code, which does not work:
please can someone help.
Private Sub Cmd_X_Click()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsCount As Integer
Dim BizNO As Field
Dim Bank_Role As Field
Dim i, j As Integer
Set db = CurrentDb()
Set rs_date = db.OpenRecordset("TRD_Pricing-In date_REAL")
Set PE_ID = rs_date.Fields("Pricing_Element_ID")
rs_date.MoveLast
rs_dateCount = rs_date.RecordCount
MsgBox (rs_dateCount)
MsgBox (Me.Pricing_Element_ID)
MsgBox (PE_ID.Value)
rs_date.MoveLast
For i = 1 To rs_dateCount
If Me!Pricing_Element_ID = PE_ID Then
rs_date.DELETE
Else
rs_date.MovePrevious
End If
Next i
End Sub

In your for loop you are not comparing the right elements. When you do:
Set PE_ID = rs_date.Fields("Pricing_Element_ID")
you set PE_ID to the value of the Pricing_Element_ID of the first record. You intend to set a reference to it, and everytime the recordset advances to the next record, you want this reference to be updated. But that's not how it works. You have to get the field in the current record every time you advance the recordset. So you have to write:
If Me!Pricing_Element_ID = rs_date.Fields("Pricing_Element_ID") Then
Note: from experience I found the count of a recordset is not always accurate. So rather than a for loop, use a while loop:
While (Not EOF(rs_date))
If Me!Pricing_Element_ID = rs_date.Fields("Pricing_Element_ID") Then
rs_date.DELETE
Else
rs_date.MoveNext
End If
Wend
Note also that there is no need to proces the recordset from last to first; just advance to next until EOF.

Related

Get all possible childs/decendants of a parent

I searched for this a lot but couldn't fine anything that is usable for MS Access, I found solutions for SQL but the statements that are used are not allowed in access SQL.
So, in MS access 2019 I have a table tbContentList with an Id and ParentID. What I would like is to show all childs/decendants of a specific parent.
My table look like this:
If I want to show all the childs of Id 3, I would like to end up with the result:
Is this possible in MS access queries? It is possible with VBA but I think it's faster to do it with queries. Can anybody help me with this topic please?
the SQL equivalent:
https://www.codeproject.com/Articles/818694/SQL-Queries-to-Manage-Hierarchical-or-Parent-child
(All possible childs)
So, I was able to modify the logic from Gustav and make it suitable for my project. I put the parent result between a delimiter ";". This makes it easier to find the descendants of a specific ContentID in the query. Furthermore I had to handle Null values in the parent column since some of the ContentID are the beginning of the the tree.
Public Function GetParentIDs(ByVal lContentID As Long) As String
Static dbs As DAO.Database
Static tbl As DAO.TableDef
Static rst As DAO.Recordset
Dim strParents As String
If dbs Is Nothing Then
' For testing only.
' Replace with OpenDatabase of backend database file.
Set dbs = CurrentDb
Set tbl = dbs.TableDefs("tbContentList")
Set rst = dbs.OpenRecordset(tbl.Name, dbOpenTable)
End If
With rst
.Index = "PrimaryKey"
Do While lContentID > 0
.Seek "=", lContentID
If Not .NoMatch Then
lContentID = Nz(!ParentID.Value, 0)
If lContentID > 0 Then
strParents = ";" & CStr(lContentID) & strParents
Else
Exit Do
End If
Else
Exit Do
End If
Loop
' Leave recordset open.
' .Close
End With
' Don't terminate static objects.
' Set rst = Nothing
' Set tbl = Nothing
' Set dbs = Nothing
'Return value
If strParents = "" Then
GetParentIDs = ""
Else
GetParentIDs = strParents & ";"
End If
End Function
The query to get all Descendants from a specific ContentID. The 3 if for this example, this could be changed to another value.
SELECT tbContentList.[ContentID], tbContentList.[ParentID], tbContentList.[Item], GetParentIDs([ContentID]) AS Parents
FROM tbContentList
WHERE (((GetParentIDs([ContentID])) Like '*;3;*'));
Thanks for the help and putting me in the right direction.
You have several options. One, however, won't do and that is a recursive query using SQL only; Access can't be fooled and will claim about a circular reference. Your only chance is to create a query resolving a limited number of levels only, say, 8 or 10.
But you can cover the recursive call in a domain aggregate function like DLookup(). This is, however, very slow as DLookup() calling the query will run for each and every record. For more than some dozens of records this will most likely be unacceptable.
The fastest way, for an unlimited number of levels, I've found is to create a lookup function which walks the tree for each record. This can output either the level of the record or a compound key built by the key of the record and all keys above.
As the lookup function will use the same recordset for every call, you can make it static, and (for Jet) you can improve further by using Seek to locate the records.
Here's an example from a similar case which will give you an idea:
Public Function RecursiveLookup(ByVal lngID As Long) As String
Static dbs As DAO.Database
Static tbl As DAO.TableDef
Static rst As DAO.Recordset
Dim lngLevel As Long
Dim strAccount As String
If dbs Is Nothing Then
' For testing only.
' Replace with OpenDatabase of backend database file.
Set dbs = CurrentDb
Set tbl = dbs.TableDefs("tblAccount")
Set rst = dbs.OpenRecordset(tbl.Name, dbOpenTable)
End If
With rst
.Index = "PrimaryKey"
While lngID > 0
.Seek "=", lngID
If Not .NoMatch Then
lngLevel = lngLevel + 1
lngID = !MasterAccountFK.Value
If lngID > 0 Then
strAccount = str(!AccountID) & strAccount
End If
Else
lngID = 0
End If
Wend
' Leave recordset open.
' .Close
End With
' Don't terminate static objects.
' Set rst = Nothing
' Set tbl = Nothing
' Set dbs = Nothing
' Alternative expression for returning the level.
' (Adjust vartype of return value of function.)
' RecursiveLookup = lngLevel ' As Long
RecursiveLookup = strAccount
End Function
This assumes a table with a primary key ID and a foreign (master) key pointing to the parent record - and a top level record (not used) with a visible key (AccountID) of 0.
Now your tree will be nicely shown almost instantaneously using a query like this where Account will be the visible compound key:
SELECT
*, RecursiveLookup([ID]) AS Account
FROM
tblAccount
WHERE
(AccountID > 0)
ORDER BY
RecursiveLookup([ID]);

Listbox.List(i) error - Method or Data Member not Found

I'm trying to use a multi-select listbox so users can select cleaning tasks they have completed and mark them as done. While looping through the list I want to see if the item is selected and create a record if so. When I try to use the .List method to return the data from a specific row, I keep getting the method not found error.
I originally did not have the forms 2.0 library loaded so I thought that was the issue, but that did not resolve the problem. I've also compacted and repaired thinking it might just be an odd fluke, but that did not help either.
'loop through values in listbox since its a multi-select
For i = 0 To listCleaningTasks.ListCount - 1
If listCleaningTasks.Selected(i) Then
'add entry to cleaning log
Set rsCleaning = CurrentDb.OpenRecordset("SELECT * FROM cleaning_log;")
With rsCleaning
.AddNew
.Fields("cleaning_task_id") = Form_frmCleaning.listCleaningTasks.List(i)
.Fields("employee_id") = Me.cmbUser
.Fields("cleanroom_id") = Me.cmbCleanroom
.Fields("cleaning_time") = Now()
.Update
.Close
End With
End If
Next i
Any ideas?
Use .listCleaningTasks.ItemData(r) to pull bound column value from row specified by index.
Use .listCleaningTasks.Column(c, r) to pull value specified by column and row indices.
Open and close recordset only one time, outside loop.
Really just need to loop through selected items, not the entire list.
Dim varItem As Variant
If Me.listCleaningTasks.ItemsSelected.Count <> 0 Then
Set rsCleaning = CurrentDb.OpenRecordset("SELECT * FROM cleaning_log")
With rsCleaning
For Each varItem In Me.listCleaningTasks.ItemsSelected
`your code to create record
...
.Fields("cleaning_task_ID") = Me.listCleaningTasks.ItemData(varItem)
...
Next
.Close
End With
Else
MsgBox "No items selected.", vbInformation
End If
Of course the solution of June7 is correct. If you need to store the selected items and then later recall and re-select the list box items, consider to get the selected items comma delimited using this function
Public Function GetSelectedItems(combo As ListBox) As String
Dim result As String, varItem As Variant
For Each varItem In combo.ItemsSelected
result = result & "," & combo.ItemData(varItem)
Next
GetSelectedItems = Mid(result, 2)
End Function
Store it into one column of a table and after reading it back pass it to this sub:
Public Sub CreateComboBoxSelections(combo As ListBox, selections As String)
Dim N As Integer, i As Integer
Dim selectionsArray() As String
selectionsArray = Split(selections, ",")
For i = LBound(selectionsArray) To UBound(selectionsArray)
With combo
For N = .ListCount - 1 To 0 Step -1
If .ItemData(N) = selectionsArray(i) Then
.Selected(N) = True
Exit For
End If
Next N
End With
Next i
End Sub
This will select items in your ListBox as they were before.

VBA recordset issue

Why is it that if the number in the bracket is greater than 1272, the function returns all NA value. While if the number if smaller than 1273, the function works fine.
Set db = OpenDatabase(DBFullName)
Set rs = db.OpenRecordset("SELECT * FROM SGXIO_Database")
Dim arr As Variant
Dim temp As Range
Dim counter As Variant
Dim num As Integer
rs.MoveLast
counter = rs.RecordCount
rs.MoveFirst
'bdd is the function name
bdd = Application.Transpose(rs.GetRows(1272))
Set rs = Nothing
db.Close
Set db = Nothing
Probably because ADO sucks and runs into all sorts of memory limits you wouldn't expect. You could probably solve your problem by chunking it. Just process 1000 records at a time. Use the second parameter for GetRows to tell it where you last left off. http://www.w3schools.com/ado/met_rs_getrows.asp

Populating dictionary causing error

I am using VBA to populate a dictionary with the codes from a table, all these codes are unique. Though when I try to add them into the dictionary I get an error:
'This key is already associated with an element of this collection'
A few example of codes I'm entering in are:
GSK611, GSK612, GSK612 (However their are the odd code with DELETED00, ADMIN, HISTORY)
The method I use is:
Private Function RunContactQuery(query As String) As dictionary
On Error GoTo Catch
Dim ex As ErrEx
Dim dictionary As dictionary
Set dictionary = New dictionary
Dim rs As DAO.Recordset
Dim counter As Integer
Set rs = CurrentDb.OpenRecordset(query)
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
counter = 1
Do Until rs.EOF = True
dictionary.Add rs.Fields(0), counter
counter = counter + 1
rs.MoveNext
Loop
End If
Set RunContactQuery = dictionary
Finally:
Exit Function
Catch:
ErrEx(Err, cmstrModule & ".RunContactQuery").Throw
Resume Finally
End Function
I get the error at 'dictionary.Add rs.Fields, counter'
All of this are unique also as I've got the values in the immediate window.
Thanks for any help.
Managed to solve the problem... It was storing an object into the field 'Field2' and I wanted the value so I changed:
dictionary.Add rs.Fields(0), counter
to
dictionary.Add rs.Fields(0).value, counter
It now gets the value

Get Query Results in a String

If I run a query to select three seperate fields from each record. Is it possible to get the results for each returned in three separate strings (one for each field) so that I can cycle through them in vba code?
Yes, you can try opening a Recordset and accessing the field values like a collection.
Dim d As DAO.Database
Dim r As DAO.Recordset
Set d = CurrentDb()
Set r = d.OpenRecordset("SQL or TableName")
While Not r.EOF
Debug.Print r!Field1, r!Field2, r!Field3
r.MoveNext
Wend
r.Close
Set r = Nothing
Set d = Nothing