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])
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).
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
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.
I am using MS Access 2010-2013 and I have a update query that replaces a few text with another text. I wanted to convert the query to VBA "Sub Removereplace ()" on my form to loop through possibly a select case for each text in question and replace it if its there. I have no clue how to do this and been trying to find an working example by goggling but no luck. Any ideas? Thanks!!!
UPDATE tbl_ImportedTabDelimited SET tbl_ImportedTabDelimited.[Long Description] = Replace(Replace(Replace(Replace([Long Description]," ft","'")," in","""")," ""L""",""),",","")
WHERE (((tbl_ImportedTabDelimited.[Long Description])
Like "*ft*" Or (tbl_ImportedTabDelimited.[Long Description])
Like "*in*" Or (tbl_ImportedTabDelimited.[Long Description])
Like "*,*" Or (tbl_ImportedTabDelimited.[Long Description])
Like "*""L""*"));
Ok if you really must update things in VBA in a loop:
Sub ThisIsABadIdea()
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT Title, Name, Salary FROM Table1")
rs.MoveFirst
While Not rs.EOF
rs.Edit
' Multiple field update
If Left(rs!Title, 1) = "Z" Then
rs!Title = "Omega Man"
rs!Name = "Heston"
rs!Salary = 15000
End If
' Multiple condition on one field
Select Case rs!Title
Case rs!Title = "aa":
rs!Title = "no way!"
Case Left(rs!Title, 4) = "xyxy":
rs!Title = "Double Fem!"
Case Right(rs!Title, 2) = "-2":
rs!Title = "It's a dash two experience"
Case Else
rs!Title = "It is indescribable"
End Select
rs.Update
rs.MoveNext
Wend
rs.Close
End Sub