Hi all i have this situation in VB for Access.
GenraReport_Click() is the main function called when pressed a botton in the report.
Temp is a table containing some data like this:
Now i created a recordset rs to loop each record of Temp , by the field Item.
And it works , the problem is when i call the function prices that has to do exactley the same thing but on the field price.
The problem comes when i try to call rs!price (or rs![price] i tried both), it tells me that there are no records. I put a movefirst call at the end of the first loop to start again with the new function.
(i tried to do the main loop with price instead of item and it works so it's not the table and not the syntax the problem. What can it be?
Your Do Until loop is likely exceeding the number of records available in recordset, so compiler errors out at 'No Current Record'. Usually, the proper way to loop through a recordset is to set the iteration limit to the Recordset EOF property:
Dim rs As Recordset
Dim s As String, i As Integer
Set rs = CurrentDb.OpenRecordset("temp")
rs.MoveLast
rs.MoveFirst
s = "": i = 1
If rs.RecordCount > 0 Then
Do While Not rs.EOF ' OR Do Until rs.EOF
Select Case i
Case 1
s = CStr(rs!Price)
Case Is < rs.RecordCount
s = s & ", " & CStr(rs!Price)
Case Else
s = s & ", and " & CStr(rs!Price)
End Select
i = i + 1
rs.MoveNext
Loop
End if
rs.close
Set rs = Nothing
Related
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]);
I am using VBA to output information into an Excel worksheet that has been gathered from a SQL Server database called "PHB". I can connect to the database and pull information by calling a view.
When I dump the data into my Excel worksheet the column headings of the database data are included and I don't want that. I have to use an offset to get the data to look right. I can manipulate the results worksheet and remove the columns with VBA. If there is some switch I can use on either (VBA or T-SQL) end it seems like it would be a much cleaner and simpler approach.
Here are the relevant parts of my logic:
Public Sub Show_ProductCode()
Dim PHB_cnn As New ADODB.Connection
Dim ProductCode_qry As String
Dim ProductCode_rst As New ADODB.Recordset
Dim ProductCode_qtbl As QueryTable
Dim ProductCode As String
Dim OffsetAmt As String
Dim OffsetAmt_int As Integer
PHB_cnn.Provider = "sqloledb"
PHB_cnn.CursorLocation = adUseClient
PHB_cnn.Open p_PHB_Connect_s 'In Module
.
.
.
For Each c In DataRange_rng
ProductCode = c.Value
ProductCode_qry = "SELECT * FROM vw_ShowPurchaseHistory WHERE ProductCode = '" & ProductCode & "'"
ProductCode_rst.Open ProductCode_qry, PHB_cnn, adOpenStatic, adLockOptimistic
With ProductCode_rst
OffsetAmt = .RecordCount
If ProductCode_rst.EOF Then
Debug.Print "No Records"
Else
OffsetAmt_int = OffsetAmt_int + (CInt(OffsetAmt) * 2)
With Worksheets("Results")
Set ProductCodes_qtbl = .QueryTables.Add(ProductCode_rst, .Range("A" & OffsetAmt_int))
ProductCodes_qtbl.Refresh
End With
End If
End With
If ProductCode_rst.State = adStateOpen Then ProductCode_rst.Close
Set ProductCode_rst = Nothing
Set ProductCode_qtbl = Nothing
Next c
exit_Show_ProductCode:
If ProductCode_rst.State = adStateOpen Then ProductCode_rst.Close
Set ProductCode_rst = Nothing
Set ProductCode_qtbl = Nothing
Exit Sub
err_Show_ProductCode:
MsgBox Err.Description, vbOKOnly
Resume exit_Show_ProductCode
End Sub
My input data:
My output:
your code is going to be very inefficient as it is executing a SQL statement for each ProductCode. It would be better to loop through these values and build up a SQL IN statement and then, after the loop, execute it once e.g.
...
ProductCode_in = "('productcode1', 'productcode2','productcode3',...., 'productcode_n')"
ProductCode_qry = "SELECT * FROM vw_ShowPurchaseHistory WHERE ProductCode IN '" & ProductCode_in
...
You'll then end up with all your data in Excel with a single header row - which is simple to delete with a VBA statement (sheet.row(1).delete).
So I have a form where I can select an excel file, it'll make a table which is an exact copy of that file, and then it'll try to match fields from that table with a project table and update the matching fields. The issue is sometimes the projects field won't update. As an example the existing value is 1.0319. If my excel file has 1.026 it will not update. 1.026 does appear in the temp table. But if I change it to 1.016 in the excel it will update. Then if I change it back to 1.026, it will update. However if I change it to 1.0319, the original value, it won't update. It honestly has me baffled and I wonder if it's actually a fault in access or VB. Here's the code, I simplified it a bit by removing the other fields it tests for and the excel load as that works fine.
Dim sSQL As String
Dim db As Database
Dim recTemp, recProj As Recordset
Dim intUpdatedRecordCount As Integer
Dim bUpdatedRecord As Boolean
Dim sSelectedFieldsQuery As String
sSelectedFieldsQuery = "P_Ratio"
'Update Generator data with imported table
Set db = CurrentDb()
sSQL = "SELECT TempImpProjRes.Desc, TempImpProjRes.ElemName, TempImpProjRes.BusA, TempImpProjRes.ID, TempImpProjRes.ProjID, " & _
"TempImpProjRes.ElemID, " & sSelectedFieldsQuery & " FROM TempImpProjRes"
Set recTemp = db.OpenRecordset(sSQL, dbOpenDynaset, dbConsistent)
'begin to loop over imported data
If recTemp.RecordCount > 0 Then
recTemp.MoveFirst
Do While Not recTemp.EOF
sSQL = "SELECT Projects.ProjID, Projects.ElemID,"Projects.P_Ratio FROM Projects WHERE Projects.ProjID=" & recTemp!ProjID & " AND Projects.ElemID=" & recTemp!ElemID"
Set recProj = db.OpenRecordset(sSQL, dbOpenDynaset, dbConsistent)
intUpdatedRecordCount = 0
bUpdatedRecord = False
bUpdatedRecord = Not CDbl(Format(recProj!P_Ratio, "0.00")) = CDbl(Format(recTemp!P_Ratio, "0.00"))
intUpdatedRecordCount = intUpdatedRecordCount + BooleanToInt(bUpdatedRecord)
'if any field has been updated then we need to update the respective value in the Projects table
If intUpdatedRecordCount > 0 Then
recProj.Edit
recProj!P_Ratio = CDbl(Format(recTemp!P_Ratio, "0.0000"))
recProj!Updated = Date
recProj.Update
End If
recProj.Close
Set recProj = Nothing
recTemp.MoveNext
Loop
End If
recTemp.Close
db.Close
Set recTemp = Nothing
Set db = Nothing
I have an Access Database with a table [tblManipulate] with the following four fields populated with data:
[tblManipulate].[Name]
[tblManipulate].[Description]
[tblManipulate].[Price]
[tblManipulate].[Account code]
I also have an 150 entry table of descriptions called [tblDescLookup] that needs to be utilized like a lookup table in order to manipulate account codes. Example entries follow:
[tblDescLookup].[Description Lookup] [tblDescLookup].[Account Code Result]
*demonstration* 10000
*coding* 12000
*e-mail* 13000
What is the best way to take every record in [tblManipulate] and check the [tblManipulate].[Description] field against [tblDescLookup].[Description Lookup], assigning the account code result into the original table if a 'like' match is found?
This seems to me like one of those instances where Access is not the best tool for the job, but it is what I have been instructed to use. I would appreciate any help or insight (or alternatives!). Thank you!
Something like this should do it for you.
Dim Description As String
Dim lookupDescription As String
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset(SELECT * FROM tblManipulate)
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst 'good habit
Do Until rs.EOF = True
Description = rs("Description")
Dim rsLookUp As DAO.Recordset
Set rsLookUp = CurrentDb.OpenRecordset(SELECT * FROM tblDescLookup)
If Not (rsLookUp .EOF And rsLookUp .BOF) Then
rsLookUp .MoveFirst 'good habit
Do Until rsLookUp.EOF = True
lookupDescription = rsLookUp("Description Lookup")
If() Then 'match criteria
'assign value
End if
rsLookUp.MoveNext
Loop
Else
MsgBox "No records in the recordset."
End If
rs.MoveNext
Loop
Else
MsgBox "No records in the recordset."
End If
Oy. You're going to need a loop here. I would open up tblDescLookup in a recordset:
Set rec = CurrentDB.OpenRecordset ("Select * from tblDescLookup")
Then loop through each record and run the query that way:
Do While rec.EOF = False
Set rec2 = CurrentDB.OpenRecordset ("Select * from rec where Description like '" & rec("Description Lookup") & "'")
rec.MoveNext
Loop
Or maybe you need to make that an Update statement instead? I can't write that off the top of my head, but you get the idea.
Have you tried something like this?
Update tblManipulate as t1
Set [Account Code] = (Select [Account Code Result] from [tblDescLookup] where [Description Lookup] = t1.[Description])
I have a ADOBE.Recordset in Excel VBA returned from a query to database. How should I find a certain record in this set that fits certain criteria? Below is the code. Could anyone fill in the " 'print out the name of one person whose age is i" part for me? Thanks in advance!
Dim rs As ADOBE.Recordset
q = "select name, age from people where country = 'US'"
Set rs = conn.Execute(q) 'conn is an ADOBE.Connection
For i = 30 To 40
'print out the name of one person whose age is i
Next i
Update 1:
Thanks KazJaw! I think your solutions should work. However, I am looking for a cleaner solution -
I don't want to save the query results into a sheet. I'd prefer them in memeory.
Is there a .Find or .Search function I can use so that I don't need to implement the search with a loop (as you did in the Second Solution)?
Maybe I am being greedy here, but ideally, I'd like something like this:
Dim rs As ADOBE.Recordset
q = "select name, age from people where country = 'US'"
Set rs = conn.Execute(q) 'conn is an ADOBE.Connection
For i = 30 To 40
name = rs.Find("age = i")!name 'this line is where I am not sure how to achieve
MsgBox name & "'s age is " & i
Next i
Apologies for the formatting. I am new to the site, not sure how to properly indent the two lines in the For loop.
Update 2:
Yes KazJaw, other problem rises. ".Find" requires rs to be able to scrolled back, which requires its lockType to be set to adLockOptimistic. Haven't figured out how yet. Will post if I do.
Solution:
The Key is to use rs.Open instead of conn.Execute and to set CursorType.
Dim rs As ADOBE.Recordset
q = "select name, age from people where country = 'US' Order By i"
Set rs = New ADODB.Recordset
rs.Open Source:=q, CursorType:=adOpenStatic, ActiveConnection:=ThisWorkbook.conn 'conn is an ADOBE.Connection
For i = 30 To 40
name = rs.Find("age = i")!name 'this line is where I am not sure how to achieve
MsgBox name & "'s age is " & i
Next i
First solution, without looping, you could do it in this way but you need to stick to #mehow suggestion where age condition should be implemented in SQL query.
'return all results as of cell A2, direction down+right, in activesheet
ActiveSheet.Range("A2").CopyFromRecordset rs
Second solution, with looping, instead of your For i...Next loop try below solution.
Dim lRow as long
lRow=2
With rs
Do Until .EOF
'return only those which age equals to i
'if implemented in SQL query then you could get rid of if statement below
if .Fields(1).Value = i then
Cells(lRow, 1) = .Fields(1).Value
Cells(lRow, 2) = .Fields(2).Value
.MoveNext
lRow = lRow + 1
end if
Loop
End With
Third solution. If you really need to use .Find method then do it in this way:
'...your loop here
rs.Find "age = " & i
name = rs(0)
MsgBox name & "'s age is " & i
'... rest of your code here
Unfortunately, I'm not sure if it will work. I think you will need to sort your results by age within SQL code. If not I expect some of the ages can be omit. Some other problems could arise. Therefore try with other solutions.