I had a problem populating a ComboBox from query results in access vba. My goal was to query for one column of a table and use every record from the result as an option for the combobox.
There are some things about the properties of ComboBoxes you need to be aware of and assign properly to make this work. Here's my code that seemed to hold the correct information but did not display anything in the dropdown list:
Dim RS As DAO.Recordset
Dim SQL As String
'Clean-up. not sure if it's needed but I'm "clearing" the old data (if there's any) before putting the new in
combox.RowSourceType = "Table/Query"
combox.RowSource = ""
SQL = "SELECT [some_value] FROM [a_table] WHERE [another_value] = '" & argv(0) & "'"
combox.RowSource = SQL
This was part of another question I asked but for clearer structure I'm moving this question (and it's answer) to this thread.
Your first attempt is fine, you just need to requery the combo box to actually load in the results of the query.
Dim SQL As String
combox.RowSourceType = "Table/Query"
combox.RowSource = ""
SQL = "SELECT [some_value] FROM [a_table] WHERE [another_value] = '" & argv(0) & "'"
combox.RowSource = SQL
combox.requery 'Clears old data, loads new data
After some refactoring and fixing I came to this result which makes the ComboBox behave as I intend:
combox.RowSourceType = "Value List"
combox.RowSource = ""
SQL = "SELECT [some_value] FROM [a_table] WHERE [another_value] = '" & argv(0) & "'"
With combox
.RowSource = kombSQL
.ColumnCount = 2
.ColumnWidth = 1
.ColumnWidths = "1.5in."
End With
Set RS = CurrentDb.OpenRecordset(SQL)
RS.MoveLast
RS.MoveFirst
combox.RemoveItem 0
Do Until RS.EOF
Me.combox.AddItem RS.Fields("some_value")
RS.MoveNext
Loop
RS.Close
Set RS = Nothing
Me.combox.BoundColumn = 0
Me.combox.ListIndex = 0
Related
I have this Access application where I pull in data from a SQL server database where the date is saved as a text field. I just created the ability for the users to sort the Recordset. It is very easy for text fields but now I want to be able to sort by date but unfortunately, as I said earlier it is saved as text in this format mm-dd-yyyy.
Here is the sort code I use:
Dim strSQL As String: strSQL = "exec Liab" & strQuearyName & " '" & strSearchValue & "%' "
'Dim qdf As QueryDef: Set qdf = CurrentDb.QueryDefs(strQuearyName)
With CurrentDb.QueryDefs(strQuearyName)
.SQL = strSQL
.ReturnsRecords = True
Set rst = .OpenRecordset
End With
'SortOutput rst
'rst.Sort = DateValue("DateOfLoss")
rst.Sort = Forms("SelectLiabilityClaimForm").cobSortBy
Set rstSorted = rst.OpenRecordset
With Forms("SelectLiabilityClaimForm").lstbxClaimList
'.RowSource = queryName
Set .Recordset = rstSorted
'.OrderBy = "claimantName"
.Requery
.SetFocus
End With
How can I sort by the text date, without having to change the passthrough query (I want that as a last resort)
Hello I'm trying my best to piece together a code to have all text boxes on the form update to existing records.
All the textboxes are updating beside
Me.txtSftLvl = myrs!SafteyStockLvl
I am left with the error
Item Cannot Be Found In The Collection (3265)
I have double checked my naming on the table and textbox itself and they are fine...
Hoping someone would know what im doing wrong or a simpler way of accomplishing my goals.
Private Sub txtRcStock_AfterUpdate()
Dim qrystr1 As String
Dim mydb As Database
Dim myrs As DAO.Recordset
DoCmd.OpenQuery "qryPartDesc"
If Me.txtRcStock <> "" Then
Set mydb = CurrentDb
qrystr1 = "SELECT Desc FROM qryPartDesc WHERE [PartNumber] = '" & Me.txtRcStock & "'"
Set myrs = mydb.OpenRecordset(qrystr1)
If myrs.EOF = False Then
Me.txtRcCat = myrs!Desc
End If
qrystr1 = "SELECT Price FROM tblRecLog WHERE [PartNumber] = '" & Me.txtRcStock & "'"
Set myrs = mydb.OpenRecordset(qrystr1)
If myrs.EOF = False Then
Me.txtPrice = myrs!Price
If myrs.EOF = False Then
Me.txtSftLvl = myrs!SafteyStockLvl
End If
End Sub
Anything helps.
I have a form called [ADD_Individual_Info] that pops up when a user scans in with their ID Card and the barcode isn't in the database. However I have learned that some have just gotten new cards and the new barcode number isn't stored in the database. I have a text box [txt_copyEmail] on the form [ADD_Individual_Info] that allows the user to search their email address to find their record in the database. This is so they don't have to retype their info in again. On the same form I another text box [txt_EDIPI] with the newly scanned barcode number. I want to just update the record on my table with the new number from text box [txt_EDIPI]. The Form [ADD_Individual_Info] has a sub form [SubIndividualInfo] on it and its Source [sfrm_User_Item_Info] and its record source is [qry_User_Item_Info] this only displays the users email address and their name. I have on after update event on text box [txt_copyEmail]. That looks like this:
Private Sub txt_copyemail_AfterUpdate()
Call search_email
Me.txt_UserEmail.Value = Me.SubIndividualInfo.Form.[UserEmail]
Me.txt_UserName.Value = Me.SubIndividualInfo.Form.[UserName]
Me.txt_Office.Value = Me.SubIndividualInfo.Form.[Office]
Me.txt_Rank_Title.Value = Me.SubIndividualInfo.Form.[Rank_Title]
Me.txt_PhoneNumber.Value = Me.SubIndividualInfo.Form.[PhoneNumber]
Me.txt_IndividualID.Value = Me.SubIndividualInfo.Form.[EDIPI]
End Sub
my function code:
Function search_email()
Dim SQL As String
SQL = "SELECT tbl_User_Info.UserName, tbl_User_Info.[UserEmail]," _
& "tbl_User_Info.[Office]," _
& "tbl_User_Info.[Rank_Title]," _
& "tbl_User_Info.[EDIPI]," _
& "tbl_User_Info.PhoneNumber FROM tbl_User_Info " _
& "Where [UserEmail] LIKE '*" & Me.txt_copyemail & "*' "
Me.SubIndividualInfo.Form.RecordSource = SQL
Me.SubIndividualInfo.Form.Requery
End Function
This is so the user can verify the info is still accurate and if so they just click a button [btn_SaveandClose]. its code looks like this:
Private Sub Btn_SaveandClose_Click()
Dim db As Database
Dim rec As Recordset
Set db = CurrentDb
Set rec = db.OpenRecordset("Select * from tbl_User_Info")
rec.Edit
rec("UserEmail") = Me.UserEmail
rec("EDIPI") = Me.txt_EDIPI
rec("UserName") = Me.UserName
rec("Office") = Me.Office
rec("Rank_Title") = Me.Rank_Title
rec("PhoneNumber") = Me.PhoneNumber
rec.Update
rec.Close
Set rec = Nothing
Set db = Nothing
Me.txt_UserEmail.Value = ""
Me.txt_UserName.Value = ""
Me.txt_Office.Value = ""
Me.txt_Rank_Title.Value = ""
Me.txt_PhoneNumber.Value = ""
Me.txt_IndividualID.Value = ""
Me.txt_EDIPI.Value = ""
Me.txt_copyemail.Value = ""
Call search_email
End Sub
It is not editing the record that is displayed on the form it just update the first record on the table it comes too with the new number in text box [txt_EDIPI]. any help with my code. Or if there is a better way to make this work I am open to a better way. thanks.
The code i used on my Save and Close Button. this was to add new or just update field. I give credit to User June7 for giving me the helpful hints.
If Me.chkAddNewInfo = True Then
Dim db As Database
Dim rec As Recordset
Set db = CurrentDb
Set rec = db.OpenRecordset("Select * from tbl_User_Info")
rec.AddNew
rec("UserEmail") = Me.txt_UserEmail
rec("EDIPI") = Me.txt_EDIPI
rec("UserName") = Me.txt_UserName
rec("Office") = Me.txt_Office
rec("Rank_Title") = Me.txt_Rank_Title
rec("PhoneNumber") = Me.txt_PhoneNumber
rec.Update
rec.Close
Set rec = Nothing
Set db = Nothing
Else
Me!SubIndividualInfo.Form.EDIPI.Value = Me.txt_EDIPI
DoCmd.RunCommand acCmdSaveRecord
End If
Open recordset with filter criteria that will return only 1 record:
Set rec = db.OpenRecordset("Select * from tbl_User_Info WHERE somefield=" & input)
Or don't open recordset and just run an UPDATE action SQL with criteria for the desired record, example showing text, date, number type fields:
CurrentDb.Execute "UPDATE tablename SET field1 = '" & Me.tbxName1 & "', field2 = #" & Me.tbxName2 & "#, field3 = " & Me.tbxName3 & " WHERE ID=" & input
Or don't do either and just edit record via form. If fields are included in form's RecordSource, simply:
Me!fieldname = "some input"
I have a new database to help produce documents for order processing.
I have a query set up with only one column of results (Product Codes) determined by the order selected on the main form.
I need to be able to use this information to name my file aka
(Customer) (Product1)+(Product2)+(Product....) (Location)
I have the code to generate the line (Customer) (Product1) (Location) and am trying to get either a concatenate function or a loop function or something to get all the products to line up with a "+" in between each "line".
I have a query (Query1) set up to give me the exact data I need...
SELECT tblREF_Chemical.Abbr
FROM qry_AX_LineItems_DISTINCT INNER JOIN tblREF_Chemical ON
qry_AX_LineItems_DISTINCT.ItemId = tblREF_Chemical.[Item Number]
GROUP BY tblREF_Chemical.Abbr, qry_AX_LineItems_DISTINCT.SALESID,
tblREF_Chemical.[Proper Shipping Name]
HAVING (((qry_AX_LineItems_DISTINCT.SALESID)=[Forms]![frm_SalesOrderEntry]!
[Combo617]) AND ((tblREF_Chemical.[Proper Shipping Name]) Is Not Null));
I have a button set up on my main form to test the data output and then I intend to add the code to my code for DoCmd.Output file name.
So far the only code that has worked is...
Private Sub Command1492_Click()
Dim i As Integer
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim SQL As String
Set db = CurrentDb
SL = [Forms]![frm_SalesOrderEntry]![Combo617]
SQL = "SELECT * FROM ALL_SalesOrderItemsLineDates WHERE
ALL_SalesOrderItemsLineDates.SALESID = '" & SL & "';"
Set rst = db.OpenRecordset(SQL)
For i = 0 To DCount("*", "ALL_SalesOrderItemsLineDates",
"ALL_SalesOrderItemsLineDates.SALESID = '" & [Forms]![frm_SalesOrderEntry]!
[Combo617] & "'") - 1
Debug.Print DLookup("[Abbr]", "[tblREF_Chemical]", "[Item Number]= '" &
rst.Fields("ItemID") & "'")
rst.MoveNext
Next i
rst.Close
End Sub
I can't seem to add additional where statements within this code or use my actual query or the system presents errors at the db.OpenRecordset line of code (Errors 3061 and 3078).
Even ignoring those problems the output is multi-line and I need it to be used in a single string of text for the document name.
UPDATE1:
I am working with the code to use my query directly...
Dim i As Integer
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim SQL As String
Set db = CurrentDb
SL = [Forms]![frm_SalesOrderEntry]![Combo617]
SQL = "SELECT tblREF_Chemical.Abbr "
SQL = SQL & "FROM qry_AX_LineItems_DISTINCT INNER JOIN tblREF_Chemical ON qry_AX_LineItems_DISTINCT.ItemId = tblREF_Chemical.[Item Number] "
SQL = SQL & "GROUP BY tblREF_Chemical.Abbr, qry_AX_LineItems_DISTINCT.SALESID, tblREF_Chemical.[Proper Shipping Name] "
SQL = SQL & "HAVING ((qry_AX_LineItems_DISTINCT.SALESID)='" & SL & "'"
SQL = SQL & "AND ((tblREF_Chemical.[Proper Shipping Name]) Is Not Null)); "
Set rst = db.OpenRecordset(SQL)
Dim s As String
Do While rst(0) Is Not Null
s = s & "+" & rst(0)
rst.MoveNext
Loop
rst.Close
Debug.Print s
Unfortunately I'm now getting a run-time error 3061 - Too few parameters. Expected 1.
I have double checked my spellings and ran the query just to be sure and no matter how many results the query is getting (functioning as expected) I am still getting this error.
UPDATE2:
Through more research I learned that queries can have, for lack of better words, invisible coding. I am updating my code to remove the inner query from my query to simplify the amount of "research" my VBA has to do.
Private Sub Command1492_Click()
Dim i As Integer
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim SQL As String
Set db = CurrentDb
SL = [Forms]![frm_SalesOrderEntry]![Combo617]
SQL = "SELECT tblREF_Chemical.Abbr "
SQL = SQL & "FROM ALL_SalesOrderItemsLineDates INNER JOIN tblREF_Chemical ON ALL_SalesOrderItemsLineDates.ItemId = tblREF_Chemical.[Item Number] "
SQL = SQL & "GROUP BY tblREF_Chemical.Abbr, ALL_SalesOrderItemsLineDates.SALESID, tblREF_Chemical.[Proper Shipping Name]"
SQL = SQL & "HAVING ((ALL_SalesOrderItemsLineDates.SALESID)='" & SL & "'"
SQL = SQL & "AND ((tblREF_Chemical.[Proper Shipping Name]) Is Not Null)); "
Set rst = db.OpenRecordset(SQL)
Dim s As String
Do While rst(0) Is Not Null 'Debug error here!
s = s & "+" & rst(0)
rst.MoveNext
Loop
rst.Close
Debug.Print s
End Sub
Unfortunately I'm still getting a run-time error, but now it is 424 Object required and the debug takes me to the "Do While" line.
I think this is a step forward, but still a little stuck.
Update3:
Since the debug was taking me to the "Do While" line I returned to my functioning code and replaced the loop function with an integer based code.
Thank you #Harassed Dad! Your code was a giant help! Using your idea for a string rather than going straight to a debug.print was genius.
The below replaces my code starting where I was having issues.
Dim s As String
For i = 0 To DCount("*", "ALL_SalesOrderItemsLineDates", "ALL_SalesOrderItemsLineDates.SALESID = '" & SL & "'") - 1
s = s & "+" & rst.Fields("Abbr")
rst.MoveNext
Next i
rst.Close
Debug.Print s
My results are displaying with only one hiccup.
+CHA+DEEA+EEP+MEC+PERC+PM+PROP
There is an extra "+" at the beginning, but I'm sure I can find the solution to this tiny problem.
I hope these notes can help someone in the future. Thank you all for your help!
Private Sub Command1492_Click()
Dim i As Integer
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim SQL As String
Set db = CurrentDb
SL = [Forms]![frm_SalesOrderEntry]![Combo617]
SQL = "SELECT tblREF_Chemical.Abbr "
SQL = SQL & "FROM qry_AX_LineItems_DISTINCT INNER JOIN tblREF_Chemical ON "
SQL = SQL & "qry_AX_LineItems_DISTINCT.ItemId = tblREF_Chemical.[Item Number] "
SQL = SQL & "GROUP BY tblREF_Chemical.Abbr, qry_AX_LineItems_DISTINCT.SALESID, "
SQL = SQL & "tblREF_Chemical.[Proper Shipping Name] "
SQL = SQL & "HAVING (((qry_AX_LineItems_DISTINCT.SALESID)='" & SL & "'" 'edit here
SQL = SQL & "AND ((tblREF_Chemical.[Proper Shipping Name]) Is Not Null)); "
Set rst = db.OpenRecordset(SQL)
Dim s as string
Do While rst(0) is not null
s = s & "+" & rst(0)
rst.MoveNext
Loop
rst.Close
Debug.print s
End Sub
Your main issue is a missing space before the AND in HAVING clause.
For this very reason of readability and maintainability, consider using QueryDefs for parameterized queries (an industry best practice) to run your saved query in VBA for several reasons:
You avoid the need to concatenate or enclose quotes or escape literals by effectively divorcing SQL code from VBA (application layer) code.
MS Access will not allow you to save a query with syntax issues but VBA string queries can have such issues found at runtime.
MS Access's engine compiles and caches saved queries to best execution plan which especially helps for aggregate queries with joins. This is why saved queries are usually more efficient than VBA string queries run on the fly.
SQL (save below as a saved query)
Query now uses table aliases and HAVING conditions are moved to WHERE since no aggregate is being used.
PARAMETERS idparam LONG;
SELECT t.Abbr
FROM qry_AX_LineItems_DISTINCT q
INNER JOIN tblREF_Chemical t ON q.ItemId = t.[Item Number]
WHERE (((q.SALESID) = [idparam])
AND ((t.[Proper Shipping Name]) Is Not Null))
GROUP BY t.Abbr, q.SALESID, t.[Proper Shipping Name];
VBA
Dim db As DAO.Database, qdef AS DAO.QueryDef, rst As DAO.Recordset
Dim SQL As String, s As String
Set db = CurrentDb
' INITIALIZE SAVED QUERY
Set qdef = db.QueryDefs("mySavedQuery")
' BIND PARAMETER
qdef![idparam] = [Forms]![frm_SalesOrderEntry]![Combo617]
' OPEN RECORDSET
Set rst = qdef.OpenRecordset()
Do While rst(0) Is Not Null
s = s & "+" & rst(0)
rst.MoveNext
Loop
rst.Close
Debug.Print s
Set rst = Nothing: Set qdef = Nothing: Set db = Nothing
I have a subform bound to a SQL statement. Inside the subform, I have a few text boxes bound to the fields of this SQL. However, I have another text box that needs to be bound to a field from a different SQL statement with criteria from the first one. My code looks like below:
Dim subform As Object
Dim formFilter As String
formFilter = "SELECT * FROM my_table_1"
Set subform = Me!my_subform.Form
subform.RecordSource = formFilter
subform.field1.ControlSource = "tb1f1"
subform.field2.ControlSource = "tb1f2"
...
subform.f3.ControlSource = "= SELECT TOP 1 tb2f3 FROM my_table_2 WHERE tb2f1 = '" & [tb1f1] & "' AND tb2f2 = '" & [tb1f2] "' ORDER BY tb2f4"
I cannot use a DLOOKUP function here directly, because I need to sort the table result.
Thanks in advance for your help.
I think I would simply create a little function to go get the result you want. It would probably be best to simply rework DLookup in your own function and add sort but I won't do that here.
First the form code. Notice I am not setting the recordsource, just the value which may not be what you want.
subform.f3 = fGet_tb2f3([tb1f1], [tb1f2])
Then the function code (put in your own error handling)
Public Function fGet_tb2f3(tblf1 as String,tblf2 as String) as String
Dim rst as dao.recordset
Dim db as database
set db = currentdb
set rst = db.openrecordset("SELECT TOP 1 tb2f3 FROM my_table_2 WHERE tb2f1 = '" & tb1f1 & "' AND tb2f2 = '" & tb1f2 "' ORDER BY tb2f4",dbopensnapshot
if not rst is nothing then
if not rst.eof then fGet_tb2f3 = rst!tb2f3
rst.close
set rst = nothing
end if
db.close
set db = nothing
end Function
You can't bind controls on the same form to 2 different recordsets. The only thing you could do is pull data from 2 different recordsets, but that's probably not the best way to do anything.
In order to do that, you'd have to create a second recordset and grab that value in it. Something like:
Dim db as Database
Dim rec as Recordset
Set db = CurrentDB
Set rec = db.OpenRecordset("SELECT TOP 1 tb2f3 FROM my_table_2 WHERE tb2f1 = '" & [tb1f1] & "' AND tb2f2 = '" & [tb1f2] "' ORDER BY tb2f4")
Me.MyControlName = rec(0)