I have a (poorly designed) db that contains a table of Volunteers. Within this table are 70+ Yes/No fields. Each field represents a County that each Volunteer could elect to serve. Each Volunteer could select multiple Counties.
I have a report that must allow selection of multiple Counties. That list must then be compared to the Boolean fields selection by selection, retaining records with only True values.
If you check some of my recent questions, I've had similar problems, but the difference was displaying boolean selections as text on the report. Only just now discovered selection criteria code isn't doing what I thought ... Here's what's been done so far:
Dim s As Variant
Dim ctl As Control
Dim t As TCondition 'this is to compile multiple variables into one large "where" clause to run the report. 3 such variables are coded in this function.
Set ctl = Me.Counties
If ctl.ItemsSelected.Count <> 0 Then
If t.WhereCondition = "" Then
For Each s In ctl.ItemsSelected
t.WhereCondition = (ctl.ItemData(s) & " = -1")
Next s
Else
For Each s In ctl.ItemsSelected
t.WhereCondition = t.WhereCondition & " AND (ctl.ItemData(s) = -1)"
Next s
End If
End If
Where this broke on me was if someone selected more than one County. I realized they were only getting the last County selected.
For Example - Counties: red, blue, silver, and green would only return Green.
A similar issue had come up with Volunteer Positions. I needed to account for selecting multiple
So I found the following:
Public Function listBoxToString(ByRef theListBox As ListBox, Optional ByVal theDelimiter As String = vbNullString)
Dim varTemp As Variant
listBoxToString = vbNullString
For Each varTemp In theListBox.ItemsSelected
If listBoxToString <> vbNullString Then listBoxToString = listBoxToString & ","
listBoxToString = listBoxToString & theDelimiter & theListBox.ItemData(varTemp) & theDelimiter
Next varTemp
End Function
This takes all selections of a ListBox and makes a comma separated list of them. This WORKED for the Positions fields (there are multiple) because those field values are TEXT.
I tried to apply that to Counties as follows:
Dim s As String
Dim ctl As Control
Dim t As TCondition
Set ctl = Me.Counties
If ctl.ItemsSelected.Count <> 0 Then
s = listBoxToString(Me.Counties, Chr(34))
If t.WhereCondition = "" Then
t.WhereCondition = (ctl.ItemData(s) & " = -1")
Else
t.WhereCondition = t.WhereCondition & " AND (ctl.ItemData(s) = -1)"
End If
End If
It does NOT work for Counties, because ListBox returns TEXT that must then be compared to values in County that are BOOLEAN. So, logically, I get Data Type Mismatch error.
I have a separate piece of code, used to help display the Counties list on the report. It pulls records at runtime, takes the ID of the record, zeroes in on the Indexes of the Boolean fields, and converts them to the Name of the fields:
Public Function MakeListCounties(intID As Integer) As String
Dim rs As DAO.Recordset
Dim strList As String
Dim x As Integer
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Volunteer WHERE ID=" & intID)
For x = 44 To 105
If rs(x).Type = dbBoolean Then
If rs(x) = True Then strList = strList & rs(x).Name & ", "
End If
Next
If strList <> "" Then MakeListCounties = Left(strList, (Len(strList) - 2))
rs.Close
Set rs = Nothing
End Function
Is there a way to work with this to get what I want? This may be superfluous, and, if so, apologies, and completely ignore that part.
To recap - I need to iterate through a ListBox of values, compare them with values of 70+ Boolean fields, retaining only records where Boolean = True for field names matching value(s) in the ListBox
Build function in a general module that returns a True or False. Call from query with expression like: MC: MatchCounties([ID]) with filter criteria of =True.
Assuming the combobox lists county names exactly matching the yes/no field names, consider:
Function MatchCounties(intID As Integer) As Boolean
Dim rs As DAO.Recordset
Dim varItem As Variant
With Forms!formname.Counties
If .ItemsSelected.Count <> 0 Then
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Volunteer WHERE ID=" & intID)
For Each varItem In .ItemsSelected
If rs(.ItemData(varItem)) Then 'use the listbox value as field name and test for True
MatchCounties = True
Exit For 'only need to match 1 yes/no county field to retrieve record
End If
Next
rs.Close
Set rs = Nothing
End If
End With
End Function
If no items selected in listbox, no records will return because the function will return False. If you want to allow no selection and still return records, then likely want the function to return True if .ItemsSelected.Count = 0. Adjust code with an Else.
Change your first code snippet to the following. The reason you were always getting the last county is because your loop was overwriting the previous WHERE clause values.
Dim s As Variant
Dim ctl As Control
Dim t As TCondition
Set ctl = Me.Counties
If ctl.ItemsSelected.Count <> 0 Then
For Each s In ctl.ItemsSelected
t.WhereCondition = t.whereCondition & ctl.ItemData(s) & " = -1 OR"
Next s
' trim trailing " OR"
t.WhereCondition = Left(t.WhereCondition, Len(t.WhereCondition)-3)
End If
enter image description herei have a program that create field tickets, when the ticket is finished i can see it in a list box name FinishedJobs, when i double click on a ticket inside the listbox it ask me if i want to reopen it or send it to print. The first one (reopen) is done but the second one i can't get it to work.
The problem is i have the ticket number in a variable named strCriteria and i want to use that value and put it in the criteria inside the query name JobsTicketGeneralReport, so i can open a report using that query.
PLEASE HELP ME TO CHANGE THE CRITERIA IN THE QUERY TO SEARCH MY TICKET NUMBER. I'M WILLING TO CHANGE THE CODES IF YOU SUGGEST THAT.
NOTE: My query is a combine query it has 6 tables and has the ticket number in common, when i call the ticket number it bring the information of all tables.
This what i am doing:
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rst As Recordset
Dim varItem As Variant
Dim strCriteria As String
Dim qdfOld As String
Dim strSQL As String
' Get the database and stored query
Set db = CurrentDb()
Set qdf = db.QueryDefs("JobsticketGeneralReport")
' Loop through the selected items in the list box and build a text string
For Each varItem In Me!List0.ItemsSelected
strCriteria = strCriteria & ",'" & Me.List0.Column(0) & "'"
Next varItem
' Check that user selected something
If Len(strCriteria) = 0 Then
MsgBox "You did not select anything from the list" _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
'Debug.Print strCriteria
' Remove the leading comma from the string
strCriteria = Right(strCriteria, Len(strCriteria) - 1)
Debug.Print strCriteria
' change criteria in query
qdf.Parameters(0).Value = Trim(strCriteria)
Set rst = qdf.OpenRecordset
DoCmd.OpenQuery "JobsticketgeneralReport"
DoCmd.OpenReport "JobsticketgeneralReport", acpreview
rst.Close
qdf.Close
Set rst = Nothing
Set qdf = Nothing
HERE IS MY SQL:
SELECT JobsOrder.StartDigDate, JobsOrder.Ticket, JobsOrder.DigNumber, JobsOrder.JobType,
JobsOrder.JobAddressNumber, JobsOrder.JobAddressName, JobsOrder.JobAddressTown,
JobsOrder.JobDescription, JobsOrder.AssetID, JobsOrder.Notes, JobsOrder.FINISH,
JobsOrder.updateGIS, JobsOrder.Priority, GENERAL.STARTJOBDATE, GENERAL.ENDJOBDATE,
GENERAL.DAY1, GENERAL.DAY2, GENERAL.EMPLOYEE0, GENERAL.EMPLOYEE1, GENERAL.EMPLOYEE2,
GENERAL.EMPLOYEE3, GENERAL.EMPLOYEE4, GENERAL.EMPLOYEE5, GENERAL.EMPLOYEE6,
GENERAL.EMPLOYEE7, GENERAL.VEHICLE0, GENERAL.VEHICLE1, GENERAL.VEHICLE2,
GENERAL.VEHICLE3, GENERAL.VEHICLE4, GENERAL.VEHICLE5, GENERAL.EMPLOYEE0TIME,
GENERAL.EMPLOYEE1TIME, GENERAL.EMPLOYEE2TIME, GENERAL.EMPLOYEE3TIME,
GENERAL.EMPLOYEE4TIME, GENERAL.EMPLOYEE5TIME, GENERAL.EMPLOYEE6TIME,
GENERAL.EMPLOYEE7TIME, GENERAL.DRAWINGATT, GENERAL.FINISH, GENERAL.ASPHALT,
GENERAL.ROW, GENERAL.CONCRETE, GENERAL.DIRT, GENERAL.TRENCH, MAINS.[JOBTYPE-MAIN],
MAINS.MATERIAL, MAINS.SIZE, MAINS.DEPTH, MAINS.INTERNALCONDITION, MAINS.COMMENTS,
MAINS.REPAIRLOCATION, MAINS.LOCATION1, MAINS.LOCATION2, MAINS.MATERIAL1,
MAINS.MATERIAL2, MAINS.MATERIAL3, MAINS.MATERIAL4, MAINS.MATERIAL5,
MAINS.MATERIAL6, MAINS.MATERIAL7, MAINS.MATERIAL8, MAINS.MATERIAL9,
MAINS.MATERIAL10, MAINS.MATERIAL11, MAINS.MATERIAL12, MAINS.QTY1, MAINS.QTY2,
MAINS.QTY3, MAINS.QTY4, MAINS.QTY5, MAINS.QTY6, MAINS.QTY7, MAINS.QTY8,
MAINS.QTY9, MAINS.QTY10, MAINS.QTY11, MAINS.QTY12, MAINS.ENABLE, SERVICES.JOBPERFORMBY,
SERVICES.SERVICEASSET, SERVICES.OFFON, SERVICES.[MATERIAL-MC], SERVICES.[SIZE-MC],
SERVICES.[DEPTH-MC], SERVICES.[MATERIAL-CB], SERVICES.[SIZE-CB], SERVICES.[DEPTH-CB],
SERVICES.CURBBOXLOCATION, SERVICES.LOCATION1, SERVICES.LOCATION2, SERVICES.LOCATION3,
SERVICES.[SERVICE-COMMENT], SERVICES.[MATERIAL1-MC], SERVICES.[MATERIAL2-MC],
SERVICES.[MATERIAL3-MC], SERVICES.[MATERIAL4-MC], SERVICES.[MATERIAL5-MC],
SERVICES.[MATERIAL6-MC], SERVICES.[MATERIAL7-MC], SERVICES.[MATERIAL8-MC],
SERVICES.[QTY1-MC], SERVICES.[QTY2-MC], SERVICES.[QTY3-MC], SERVICES.[QTY4-MC],
SERVICES.[QTY5-MC], SERVICES.[QTY6-MC], SERVICES.[QTY7-MC], SERVICES.[QTY8-MC],
SERVICES.[MATERIAL1-CB], SERVICES.[MATERIAL2-CB], SERVICES.[MATERIAL3-CB],
SERVICES.[MATERIAL4-CB], SERVICES.[MATERIAL5-CB], SERVICES.[MATERIAL6-CB],
SERVICES.[MATERIAL7-CB], SERVICES.[MATERIAL8-CB], SERVICES.[QTY1-CB],
SERVICES.[QTY2-CB], SERVICES.[QTY3-CB], SERVICES.[QTY4-CB], SERVICES.[QTY5-CB],
SERVICES.[QTY6-CB], SERVICES.[QTY7-CB], SERVICES.[QTY8-CB], SERVICES.REPAIR,
SERVICES.Replace, SERVICES.INSTALL, SERVICES.REMOVE, SERVICES.TEMPDISCONNECT,
SERVICES.ENABLE, HYDRANT.[ENABLE-H], HYDRANT.[HYDRANT-ASSET], HYDRANT.[REPAIR-H],
HYDRANT.[REPLACE-H], HYDRANT.[INSTALL-H], HYDRANT.FLUSH, HYDRANT.FLOWTEST,
HYDRANT.PARTS1, HYDRANT.PARTS2, HYDRANT.PARTS3, HYDRANT.PARTS4, HYDRANT.PARTS5,
HYDRANT.PARTS6, HYDRANT.PARTS7, HYDRANT.PARTS8, HYDRANT.[QTY1-H], HYDRANT.[QTY2-H],
HYDRANT.[QTY3-H], HYDRANT.[QTY4-H], HYDRANT.[QTY5-H], HYDRANT.[QTY6-H],
HYDRANT.[QTY7-H], HYDRANT.[QTY8-H], HYDRANT.JOBPERFORM, HYDRANT.[MANUFACTORY OLD],
HYDRANT.MANUFACTORY, HYDRANT.SIZENEW, HYDRANT.SIZEOLD, HYDRANT.JOBNOTES,
HYDRANT.TIMEOPEND, HYDRANT.TIMECLOSED, HYDRANT.TIMETOCLEAR, HYDRANT.COLOROPEN,
HYDRANT.COLORCLOSE, HYDRANT.REMARKS, HYDRANT.[STATIC-PRESSURE], HYDRANT.[RESIDUAL-PRESSURE],
HYDRANT.[PITOT-TESTFLOWRATE], HYDRANT.CAPACITY, HYDRANT.[ASSET-ID1],
HYDRANT.[ASSET-ID2], VALVES.ENABLE, VALVES.[REPAIR-V], VALVES.[REPLACE-V],
VALVES.[INSTALL-V], VALVES.[REMOVE-V], VALVES.[MAINTENANCE-V], VALVES.VALVECOMMENT,
VALVES.[MATERIAL1-V], VALVES.[MATERIAL2-V], VALVES.[MATERIAL3-V], VALVES.[MATERIAL4-V],
VALVES.[MATERIAL5-V], VALVES.[MATERIAL6-V], VALVES.[QTY1-V], VALVES.[QTY2-V],
VALVES.[QTY3-V], VALVES.[QTY4-V], VALVES.[QTY5-V], VALVES.[QTY6-V],
VALVES.[LOCATION1-V], VALVES.[LOCATION2-V], VALVES.[LOCATION3-V], VALVES.[LOCATION4-V],
VALVES.VALVE1, VALVES.VALVE2, VALVES.VALVE3, VALVES.VALVE4, VALVES.VALVE5,
VALVES.VALVE6, VALVES.VALVE7, VALVES.VALVE8, VALVES.VALVEPOSITION1,
VALVES.VALVEPOSITION2, VALVES.VALVEPOSITION3, VALVES.VALVEPOSITION4,
VALVES.VALVEPOSITION5, VALVES.VALVEPOSITION6, VALVES.VALVEPOSITION7,
VALVES.VALVEPOSITION8, VALVES.[VALVE-TURNS1], VALVES.[VALVE-TURNS2],
VALVES.[VALVE-TURNS3], VALVES.[VALVE-TURNS4], VALVES.[VALVE-TURNS5],
VALVES.[VALVE- TURNS6], VALVES.[VALVE-TURNS7], VALVES.[VALVE-TURNS8],
VALVES.[VALVE-DEPTH1], VALVES.[VALVE-DEPTH2], VALVES.[VALVE-DEPTH3],
VALVES.[VALVE-DEPTH4], VALVES.[VALVE-DEPTH5], VALVES.[VALVE-DEPTH6],
VALVES.[VALVE-DEPTH7], VALVES.[VALVE-DEPTH8], VALVES.REASON1, VALVES.REASON2,
VALVES.REASON3, VALVES.REASON4, VALVES.REASON5, VALVES.REASON6, VALVES.REASON7,
VALVES.REASON8, INSPECT.ENABLE, INSPECT.[CURBBOX-I], INSPECT.[VALVEBOX-I],
INSPECT.[SERVICE-I], INSPECT.CURBBOXREMARKS, INSPECT.VALVEBOXREMARKS, INSPECT.SERVICEREMARKS
FROM (((((JobsOrder
INNER JOIN [GENERAL] ON JobsOrder.Ticket = GENERAL.TICKET)
INNER JOIN MAINS ON GENERAL.TICKET = MAINS.TICKET)
INNER JOIN SERVICES ON MAINS.TICKET = SERVICES.TICKET)
INNER JOIN HYDRANT ON SERVICES.TICKET = HYDRANT.TICKET)
INNER JOIN VALVES ON HYDRANT.TICKET = VALVES.TICKET)
INNER JOIN INSPECT ON VALVES.TICKET = INSPECT.TICKET
WHERE (((JobsOrder.Ticket)=[ticket])
AND ((JobsOrder.FINISH)=True))
ORDER BY JobsOrder.StartDigDate, JobsOrder.Ticket;
If you want to use a parameter in the query, you should explicitly define it. Also, it is a good idea to give the parameter a different name than the involved tables and fields.
To do this, use the "Parameters" window in query design, or add a PARAMETERS clause to the beginning of the SQL:
PARAMETERS parTicket Text ( 255 );
SELECT .....
and in the WHERE clause
WHERE (((JobsOrder.Ticket)=[parTicket])
This is mainly useful if you want to read data from the query in VBA, i.e. you need this for
Set rst = qdf.OpenRecordset
But if the query is RecordSource for a report, this won't work, because the report opens its own instance of the query. In this case, you need Parfait's solution: directly use the listbox in the query.
WHERE ((JobsOrder.Ticket) = Forms!yourForm!List0)
For Each varItem In Me!List0.ItemsSelected
strCriteria = strCriteria & ",'" & Me.List0.Column(0) & "'"
Next varItem
This cannot work - you must use varItem in the loop.
Me.List0.Column(0) will always pick the same element.
Debug.Print strCriteria
This should have told you what went wrong.
I am trying to make a form which searches for the value inside all of the tables in the database (there are more than 1 table). The result will be displayed as the name of the table which this appears in. If someone can help me that will be nice.
In short, I have a form with a textbox and button. I enter the search string (for example 183939) and click on the button. It searches the value (183939) inside all the fields in the tables in the database, and if the value is found, then it displays the name of the table that it appears in. Thanks for the help.
I think this is a bad idea because it could take a very long time, and provide confusing results due to also searching system tables... but the following function will return an array of all table names containing the search term or nothing if it wasn't found. Calling example is such: theTables = containingTable("hello") where theTables is a variant. A limitation is that this will fail for multi-valued fields.
Function containingTables(term As String)
Dim db As Database
Dim tds As TableDefs
Dim td As TableDef
Set db = CurrentDb
Set tds = db.TableDefs
For Each td In tds
For Each f In td.Fields
On Error Resume Next
If DCount("[" & f.Name & "]", "[" & td.Name & "]", "[" & f.Name & "] LIKE '*" & term & "*'") Then
If Err.Number <> 0 Then
Debug.Print Err.Number, Err.Description
Err.Clear
On Error GoTo 0
Else
containingTables = containingTables & td.Name & ","
Exit For
End If
End If
Next
Next
Set tds = Nothing
Set db = Nothing
'Alternate Version
if Len(containgingTables) then containingTables = Left(containingTables, Len(containingTables) - 1)
'Original Version
'if Len(containgingTables) then containingTables = Split(Left(containingTables, Len(containingTables) - 1), ",")
End Function
To display the results with the alternate version, just use: Msgbox(containingTables(searchTerm)) where searchTerm is whatever you are searching.
Me as well i don't know why you would want to do something like that...
I think the solution posted by Daniel Cook is correct, i just took a slightly different approach. Do you need to match the exact value like I do? Anyway, here's my code:
Function searchTables(term as String)
Dim T As TableDef
Dim Rs As Recordset
Dim Result() As String
Dim Counter
Counter = 0
For Each T In CurrentDb.TableDefs
If (Left(T.Name, 4) <> "USys") And (T.Attributes = 0) Then
Set Rs = T.OpenRecordset
While Not Rs.EOF
For Each Field In Rs.Fields
If Rs(Field.Name) = term Then
Counter = Counter + 1
ReDim Preserve Result(Counter)
Result(Counter) = T.Name & "," & Field.Name
End If
Next
Rs.MoveNext
Wend
Rs.Close
End If
Next
If Counter = 0 Then
searchTables = Null
Else
searchTables = Result
End If
End Function
You should filter out duplicated values, in case the function matches multiple times the same filed in the same table.
I am creating a bill of materials program.
There are two main tables named Products and Sub_Products.
In the Products table, the fields are (Product_Name, Code).
In the Sub_Products table, the fields are (Code, Sub_Name).
The tables are linked with code, i.e.: one product is made up of many sub_products, each sub_product is a product as well, making it have many sub_products.
I have created a query that reads a product and gets its sub_products. I need a query to compare Sub_Name with Product_Name and then check more sub_products,
continuing until no more sub_products are found.
Any ideas?
I guess you will have to use a script rather than SQL query to loop through them. Assuming that the products can be nested more than 3 levels.
I've been working on this exact problem in an ASP.NET MVC application. A function that gathered all the subproducts for each product and recursed on each subproduct worked well. We have some BOMs that are 15 levels deep.
I realize this question was asked a long time ago, but I had a very similar question and finally figured out a good answer. So I am posting it here in case anyone needs to know how to create a Bill of Materials.
In my example there is a table called "Part_Item_Table" which lists parent items and all of their childeren. Those childeren can also be parents to other childeren. The difficulty was that the BOM could be 3 levels deep all the way up to 30 levels deep or more. My "Part_Item_Table" also lists whether items are "Make" items or not. Only "Make" items will have childeren. The table you are querying may not have that feature, but the code below will probably still be helpful to get the idea.
This set of code uses several things that were new to me such as recursive code, calling a query I had already created and passing in a variable using the querydef methods, and using recordsets to get large information sets in and out of functions. I also used a sequence field in my BOM Table so I could sort by it and view the BOM in the order it is meant to be (Showing visually which level 3 items roll up into which level 2 items). If there is something that can be improved I am open to suggestions. This does work for my needs right now and hopefully it is helpful to someone else.
Option Compare Database
Public stFirstPart As String
Private Const BOMTable As String = "BOM_Table" 'Set this variable to the name of the table
Private Const ComponentQ As String = "GetComponentsQ" 'Set to the name of the query in the database
Function BOM()
Dim stQuery As String 'Used to make a query
Dim i As Integer 'Used to create the sequence number
Dim iLevel As Integer 'Used to show BOM level
Dim rsParent, rsBOMTable As DAO.Recordset 'Used to hold query results
'Make sure there is a part number in the form
If IsNull(Forms![Entry Form]![Part_Number]) Then
Debug.Print "There is no part number entered in the form"
MsgBox "There is no part number in the form.", vbOKOnly, "Can't fool me."
Exit Function
End If
stFirstPart = Forms![Entry Form]![Part_Number] 'Get the top part number from the form
'Make sure this is a Make item. Only make items will have childeren
stQuery = "SELECT ITEM.ITEM_NO, ITEM.MAKE_BUY_FLAG, ITEM.CURRENT_FLAG " & _
" FROM PART_ITEM_TABLE AS ITEM " & _
" WHERE (((ITEM.ITEM_NO)='" & stFirstPart & "') AND ((ITEM.MAKE_BUY_FLAG)='M') AND ((ITEM.CURRENT_FLAG)='Y'));"
Set rsParent = CurrentDb.OpenRecordset(stQuery)
If rsParent.EOF And rsParent.BOF Then
Debug.Print "This is not a make item"
MsgBox "This is not a Make item.", vbOKOnly, "I tried."
Exit Function
End If
'Clear the BOM table and load this first part number
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete from " & BOMTable & ""
Set rsBOMTable = CurrentDb.OpenRecordset(BOMTable, dbOpenDynaset)
i = 1
iLevel = 1
rsParent.MoveFirst
With rsBOMTable
.AddNew
!Sequence = i
!Level = iLevel
!Item_Number = stFirstPart
!Make_Buy = "M"
.Update
End With
rsParent.Close
Set rsParent = Nothing
rsBOMTable.Close
Set rsBOMTable = Nothing
'-----------------------------------------------------------------------------------------------------------------------------------
'Start going down levels
'-----------------------------------------------------------------------------------------------------------------------------------
iLevel = 2
Call RecursiveLevels(stFirstPart, iLevel, i)
DoCmd.SetWarnings True
End Function
Function RecursiveLevels(PartNumber As String, iLevel As Integer, i As Integer)
Dim rsLevels As DAO.Recordset
Dim stPart As String
Set rsLevels = GetComponents(PartNumber)
If rsLevels.BOF And rsLevels.EOF Then
Debug.Print "This was a Make item with no children. That shouldn't happen. "; PartNumber
GoTo ExitPoint
End If
rsLevels.MoveFirst
Do While Not rsLevels.EOF
If rsLevels!Make_Buy <> "M" Then ' Anything that is not a Make item is written to the BOM table one line at a time.
i = i + 1
Call WriteToBOMTable(iLevel, i, rsLevels!Parent_Number, rsLevels!Component_Number, rsLevels!Make_Buy)
Else 'The Make item is written to the table, then we query for all of its children
stPart = rsLevels!Component_Number
i = i + 1
Call WriteToBOMTable(iLevel, i, rsLevels!Parent_Number, rsLevels!Component_Number, rsLevels!Make_Buy)
If stPart = stFirstPart Then 'Check to make sure this recursive thing doesn't go on forever.
Debug.Print "This part number is the same as the first part number. Circ Reference. "; stPart
GoTo ExitPoint
End If
iLevel = iLevel + 1 ' get ready to go one level deeper
Call RecursiveLevels(stPart, iLevel, i)
End If
rsLevels.MoveNext
Loop
ExitPoint:
iLevel = iLevel - 1 'Done with this level. Come back up a level.
rsLevels.Close
Set rsLevels = Nothing
End Function
Function WriteToBOMTable(Level As Integer, i As Integer, ParentNumber As String, ComponentNumber As String, MakeBuy As String)
Dim rsBOMTable As DAO.Recordset
Set rsBOMTable = CurrentDb.OpenRecordset(BOMTable, dbOpenDynaset)
With rsBOMTable
.AddNew
!Parent_Number = ParentNumber
!Item_Number = ComponentNumber
!Level = Level
!Make_Buy = MakeBuy
!Sequence = i
.Update
End With
Debug.Print "Level: "; Level; "Component: "; ComponentNumber
rsBOMTable.Close
Set rsBOMTable = Nothing
End Function
Function GetComponents(PartNumber As String) As DAO.Recordset
Dim qdf As QueryDef
Set qdf = CurrentDb.QueryDefs(ComponentQ)
qdf.Parameters("PartNumber") = PartNumber
Set GetComponents = qdf.OpenRecordset
End Function