Get Query Results in a String - vba

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

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]);

Assign Value from Query with sum to Textbox

I am trying to assign the value from a SQL Query to a text box.
I have the function tied to a ComboBox After update.
I tested the SQL by running it.
How do I assign the result to the Txtbox named prepoffEIC?
Dim MyVar2 As Integer
MyVar2 = Me.SelectedExam.Column(0)
ExamViewQry = "SELECT Sum(tblentrys.entryhours) AS TotalHoursPerFunction FROM tBleExams INNER JOIN (tBlBankList INNER JOIN (tBlExaminers INNER JOIN (tBlEntrys INNER JOIN tBlActivity ON tBlEntrys.EntryActivityID = tBlActivity.FunctionKey) ON tBlExaminers.ExaminersKey = tBlEntrys.EntryExaminerID) ON tBlBankList.BankID = tBlEntrys.EntryInstitutionID) ON (tBlBankList.BankID = tBleExams.ExamBankID) AND (tBleExams.ExamID = tBlEntrys.EntryExamID) WHERE tBlEntrys.EntryActivityID=1 AND tblEntrys.EntryExamStageID=1 AND tBleExams.ExamID=" & MyVar2
Me.prepoffEIC.ControlSource = "ExamViewQry"
Me.prepoffEIC.Requery
Create a query using the sql you have, but slightly modded paste it here:
PARAMETERS eid long;
SELECT Sum(tblentrys.entryhours) AS TotalHoursPerFunction
FROM tBleExams
INNER JOIN (
tBlBankList INNER JOIN (
tBlExaminers INNER JOIN (
tBlEntrys INNER JOIN tBlActivity ON tBlEntrys.EntryActivityID = tBlActivity.FunctionKey
) ON tBlExaminers.ExaminersKey = tBlEntrys.EntryExaminerID
) ON tBlBankList.BankID = tBlEntrys.EntryInstitutionID
) ON (tBlBankList.BankID = tBleExams.ExamBankID)
AND (tBleExams.ExamID = tBlEntrys.EntryExamID)
WHERE tBlEntrys.EntryActivityID = 1
AND tblEntrys.EntryExamStageID = 1
AND tBleExams.ExamID = [eid]
lets call it qryGetHours (since i dont know what you need it for.)
in the after update event (also use better naming, this is quick and dirty)
dim db as DAO.Database
dim qry as QueryDef
dim rs as DAO.Recordset
set db = currentdb
set qry = db.querydefs("qryGetHours")
'this is the name of the query you made above
qry.parameters("eid").value = me.SelectedExam.Column(0)
set rs = qry.openrecordset(dbopendynaset,dbseechanges)
'dbseechanges is more for if you have a sql server backend, but i usually do
if not ( rs.eof and rs.bof) then
rs.movefirst
me.prepoffEIC = rs.fields("TotalHoursPerFunction").value
'This portion assumes that you only get one record back,
'or if you do end up with more than one, it only goes
'after the first one.
else
msgbox "Errors... Errors everywhere."
'You will definitely want to put something meaningful
'here relating to it not being able to find the data you
'were looking for.
end if
if not rs is nothing then
rs.close
set rs = nothing
end if
set qry = nothing
set db = nothing
'you will always want to do this portion where you properly
'check if a recordset exists and then close it when you are
'done, along with closing out the querydef and database variables.

VBA on click_ delete records of a table

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.

How to query a delimited value list generated by function (Access)

I've got a module sub getFileList() that generates a value list that outputs the following:
10347 C;12-0605 TPX;12-0713 tpx;13-0915 tpx;13-4304 tpx;1345 c;1375 c;14-4201 tpx;
I wanted to build a query against this function.
In the SQL view I've got the following:
SELECT getFileList("\\wwdata\dev\_commons\color","*.jpg") as colors;
Right now the value list is all in one record.
Colors
10347 C;12-0605 TPX;12-0713 tpx; etc....
What function/command is available to make this into a list with each delimited item as a record.
Desired output.
Colors
10347 C
12-0605 TPX
12-0713 tpx
13-0915 tpx
13-4304 tpx
1345 c
etc....
Thanks in advance.
For me, personally, I'd prefer to parse that delimited string in to an actual table in Access, and then run whatever query you want off that.
The following assumes there's already an empty table called "tblColors" and a short text field in that table called "Colors", which will be the target for parsing each ";" delimited item in your string into its own record in that table:
Private Sub Command0_Click()
Dim myDelimStr As String
Dim arrayToParse As Variant
Dim i As Integer
Dim arrayMsg As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("tblColors")
myDelimStr = "10347 C;12-0605 TPX;12-0713 tpx;13-0915 tpx;13-4304 tpx;1345 c;1375 c;14-4201 tpx;"
arrayToParse = Split(myDelimStr, ";", -1, vbTextCompare)
For i = 0 To UBound(arrayToParse) - 1
rs.AddNew
rs("Colors").Value = arrayToParse(i)
rs.Update
arrayMsg = arrayMsg & arrayToParse(i) & vbCrLf
Next i
Debug.Print "The array has parsed the following to the Colors table: " & vbCrLf & arrayMsg
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
You'll probably want to set myDelimStr to myDelimStr = getFileList("\\wwdata\dev\_commons\color","*.jpg") too.

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