Take for example this code:
sSQL = "select CtyMarket from Market where Country = '" & Country.Value & "'"
Set rec = CurrentDb.OpenRecordset(sSQL)
This statement can return more than one value. How can I access those values?
well, in order to get all the values you could browse both fields and records in your recordset. It could look like that:
'You'll need to declare a new variable
Dim i as long
If rec.EOF and rec.BOF then
Else
do while not rec.EOF
for i = 0 to rec.fields.count - 1
debug.print rec.fields(i).value
next i
rec.movenext
loop
endif
Other ways to get your data would be to use the getrows and\or getstring metyhods of the recordset object, but I do not remember if these are available with DAO recordsets. You could also set a filter for a specific value on a specific field, etc
I use this function to not care about NULL values when reading recordsets:
Public Function toStr(pVar_In As Variant) As String
On Error Resume Next
toStr = CStr(pVar_In)
End Function
Never trust the exact amount of rec.recordcount but rec.RecordCount>0 is safe. That's why you should never use a for loop when using a recordset. If you'd like to know the recordcount anyway what you have to do first is rec.movelast and then rec.movefirst
There are two different ways that I know of:
While not rec.eof
msgbox toStr(rec!CtyMarket)
rec.moveNext
Wend
or
While not rec.eof
msgbox toStr(rec.fields("CtyMarket").value)
rec.moveNext
Wend
Related
I am trying to get a record based on the value contain within the textbox on a form. i.e i type in the information into the textbox and other values associated with that value are returned to other textbox on the form.
I thought this would be easy but can't seem to get it to work.
Currently I was trying
Dim rst As DAO.Recordset
Dim SQL As String
Dim SQL2 As String
SQL = "SELECT tblmytbl.[IDCODE]"
"FROM tblmytbl " & _
"WHERE (((tblmytbl.[IDCODE]) = forms!myform!mybox.value "
Set db = CurrentDb
Set rst = db.OpenRecordset(SQL)
If Not ((rst.BOF = True) And (rst.EOF = True)) Then
Forms!myform!Text102 = rst.Fields("[Name]")
Forms!myform!Text103 = rst.Fields("[Surname]")enter code here
Note: The search information is alphanumeric and i have tried without the .value
Any help would be appreciated.
Thanks
The SQL you send to the server can't access the form. However, you can concatenate the value into the string that you send like:
" WHERE (((mytable.myfield) = '" & FixQuotes(Forms!myform!mybox.value) & "') " & _
Note, you may need to defend yourself against SQL injection, a simple (but not complete) defense would be something like:
Public Function FixQuotes(input as string) As String
FixQuotes = Replace(input,"'","''")
End Function
EDIT:
Based on your updated code, there's quite a number of changes you need to make. Beyond my statement above, the .OpenRecordset only applies to full tables, you can't use it with a SELECT statement. Instead, you have to instantiate a QueryDef. On top of that, you try to reference fields you didn't include in the query. Also, you can simplify the expression Forms!myform! to Me (which could help if you want to reuse the code somewhere else) So your code should look something like this:
Dim db as Database 'always dim everything, you should use Option Explicit'
Dim rst as Recordset 'DAO is the default anyway'
Dim qdf as QueryDef 'this object is required for queries'
Set db = CurrentDb
'prepare single-use query, to return the values you're going to use
'as mentioned before, the query doesn't have access to the form
'we can use Me since it references the form'
' use TOP 1 since you only expect 1 record'
Set qdf = db.CreateQueryDef("","SELECT TOP 1 Name,Surname FROM tblmytbl " & _
"WHERE IDCODE = '" & FixQuotes(Me.mybox.value) & "';")
Set rst = qdf.OpenRecordset(DbOpenForwardOnly)
'forwardonly since you only care about the first record'
If Not rst.EOF Then 'ForwardOnly has to start at the first record'
Me.Text102.Value = rst!Name
Me.Text103.Value = rst!Surname
'I highly suggest giving these boxes better names'
Else
'no record found'
End if
rst.Close
qdf.Close
db.Close 'close these objects, it can sometimes cause memory leaks otherwise'
I have a crosstab query that is being loaded into a recordset. I'm then writing the query fields to an Excel spreadsheet. The problem is that a field may not exist based on the query results.
For example, I have the following line:
oSheet5.Range("F1").Value = rsB2("AK")
...which would write the value of the recordset item named "AK" to the spreadsheet. But if "AK" doesn't exist, I get an error Item not found in this collection.
How I can I test to see if there's an item named "AK"?
I tried...
If rsB2("AK") Then
oSheet5.Range("F" & Count).Value = rsB2("AK")
End If
...but that didn't work.
I also tried...
If rsB2("AK") Is Nothing Then
oSheet5.Range("F" & Count).Value = ""
Else
oSheet5.Range("F" & Count).Value = rsB2("AK")
End If
...and still the same error.
There are 50+ items/fields to check .. all states in USA plus a few extras.
Thanks!
You can use Recordset.FindFirst Method (DAO) take a look here or here
Small example:
Sub FindOrgName()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
'Get the database and Recordset
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblCustomers")
'Search for the first matching record
rst.FindFirst "[OrgName] LIKE '*parts*'"
'Check the result
If rst.NoMatch Then
MsgBox "Record not found."
GotTo Cleanup
Else
Do While Not rst.NoMatch
MsgBox "Customer name: " & rst!CustName
rst.FindNext "[OrgName] LIKE '*parts*'"
Loop
'Search for the next matching record
rst.FindNext "[OrgName] LIKE '*parts*'"
End If
Cleanup:
rst.Close
Set rst = Nothing
Set dbs = Nothing
End Sub
You could add an error handler to catch the item not found error ... ignore it and/or do something else instead.
Or if the first recordset field always maps to the first sheet column regardless of the field's name, you can reference it by its ordinal position: rsB2(0)
Or you could examine the recordset's Fields collection to confirm the field name is present before attempting to retrieve its value.
After you open the recordset, load a dictionary with its field names. This code sample uses late binding. I included comment hints in case you want early binding. Early binding requires you to set a reference for Microsoft Scripting Runtime.
Dim objDict As Object 'Scripting.Dictionary
'Set objDict = New Scripting.Dictionary
Set objDict = CreateObject("Scripting.Dictionary")
Dim fld As DAO.Field
For Each fld In rsB2.Fields
objDict.Add fld.Name, vbNullString
Next
Then later you can use the dictionary's Exists method to your advantage.
If objdict.Exists("AK") = True Then
oSheet5.Range("F1").Value = rsB2("AK")
End If
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 inherited an MS Access database at my office that is heavily used by several people over the network. This causes many issues with data collisions and locks. I want to split the db so that each user has thier own front-end app and maintain the core data on the server.
Several of the tables use an autonumber:sequence:long as thier primary key - in researching how to perform the split I've come across several posts that hint this can cause issues when distributing a database but I haven't been able to find anything solid. The issue seems to be that a user can begin a new record and receive the next autonumber but a second user can create a new record within a short interval and receive the same autonumber resulting in an error?
Does Jet handle this correctly or are there autonumber issues with a FE/BE database? If it's an unlikely-but-possile occurance I'm sure it will still be much better than what my users are currently experiencing but I'd like to know if there are ways I can minimize such issues.
Thanks for your help!
I've had the misfortune of working with many Access databases in my youth. While there are many issues with Access, I do not know if I've ever run into a problem with AutoNumber columns in a split database, multi-user environment. It should work fine. This is such a common setup that there would be posts all over the Internet about it if were an issue.
As long as you are not going for data replication (ie multiple subscriber databases, where users can insert new records in same tables but in different locations), you will not have problems with autonumbers as primary keys.
If you think that one of these days you might need to go for replication (different locations, one central database), do not hesitate to switch to unique identifiers (replication IDs).
There seems to be some confusion on your part about the process of splitting. When you do so, you end up with multiple front ends, but the back end is still a single file. Thus, there's no difference at all for the data tables in terms of Autonumbers from what you had before you split the application.
I had the same problem, nevertheless i did a workarround to get the autonumbering work from an Onload() Event
What I did is :
I create a recordset based on Your_Table everytime the user needs an autonumber
Open the recordset (rst)
Search if:
-Your_Table is Empty, then assigns the value "1" to Your_field
-Your_Table is has data without missing numbers,then assigns the value = "Count of lines + 1" to Your_field (1,2,....,n+1)
-Your_Table has missing data (1,3,4,5,7) [Note "#2 and #7 are missing]", then uses a function to search in Your_Table the missing fields and assign to Your_Field the first missing value (#2 in this example)
Private Sub Autonumbering(Your_Table As String)
Dim rst As DAO.Recordset
Dim db As Database
On Error GoTo ErrorHandler
Application.Echo False
Set db = CurrentDb
Set rst = db.OpenRecordset(Your_Table, dbOpenDynaset)
With rst
.AddNew
'Your_Table is Empty, **then** assigns the value "1" to Your_field
If DMin("[Your_Field]", Your_Table) = 1 Then
'Your_Table is has data without missing numbers,**then** assigns the value = "Count of lines + 1" to Your_field (1,2,....,n+1)
If DMax("[Your_Field]", Your_Table) = .RecordCount Then
'Assings n+1 value to [Your_Field] records
Value = .RecordCount + 1
![Your_Field] = Valor
Else
'Your_Table has missing data (1,3,4,5,7) [Note "#2 and #7 are missing]", **then** uses a function to search in Your_Table & _
the missing fields and assign to Your_Field the first missing value (#2 in this example)
Value = MyFunction$(Your_Table, "Your_Field")
![Your_Field] = Value
End If
Else
'Agrega el número 1
Value = 1
![Your_Field] = Value
End If
.Update
.Bookmark = .LastModified
Me.Requery
DoCmd.GoToRecord acDataForm, Me.Name, acGoTo, Value
.Move 0, .LastModified
End With
ErrorCorregido:
Application.Echo True
Exit Sub
ErrorHandler:
MsgBox "An error ocurred, please verify numbering", vbCritical + vbOKOnly
Resume ErrorCorregido
End Sub
Here is the function that i found to get the missing values on an specific table, i cant find it anymore, but thanks for the one who made it.
Function MyFunction$(cstrTable As String, cstrField As String)
' Read table/query sequentially to record all missing IDs.
' Fill a ListBox to display to found IDs.
' A reference to Microsoft DAO must be present.
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim lst As ListBox
Dim Col As Collection
Dim strSQL As String
Dim strList As String
Dim lngLast As Long
Dim lngNext As Long
Dim lngMiss As Long
' Build SQL string which sorts the ID field.
strSQL = "Select " & cstrField & "" _
& " From " & cstrTable & " Order By 1;"
Set Col = Nothing
' Control to fill with missing numbers.
'Set lst = Me!lstMissing
' Collection to hold the missing IDs.
Set Col = New Collection
'// Vacía la colección
'Erase Col
' Read the table.
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset(strSQL)
If rst.RecordCount = 0 Then
' The recordset is empty.
' Nothing to do.
Else
' Read and save the ID of the first record.
lngLast = rst(cstrField).value
rst.MoveNext
' Loop from the second record through the recordset
' while reading each ID.
While rst.EOF = False
lngNext = rst(cstrField).value
' For each ID, fill the collection with the
' missing IDs between the last ID and this ID.
For lngMiss = lngLast + 1 To lngNext - 1
Col.Add (lngMiss)
Next
' Save the last read ID and move on.
lngLast = lngNext
rst.MoveNext
Wend
' Finally, add the next possible ID to use.
Col.Add (lngLast + 1)
End If
rst.Close
For lngMiss = 1 To Col.Count
' Build the value list for the ListBox.
If Len(strList) > 0 Then
' Append separator.
strList = strList & ";"
End If
' Append next item from the collection.
strList = strList & Col(lngMiss)
' For debugging only. May be removed.
Debug.Print Col(lngMiss)
Next
' Pass the value list to the ListBox.
' Doing so will requery it too.
' lst.RowSource = strList
' For debugging only. May be removed.
' Debug.Print strList
MyFunction$ = Col(1)
' Clean up.
Set rst = Nothing
Set dbs = Nothing
Set Col = Nothing
Set lst = Nothing
End Function
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