I have create a combobox with a depending multiselection List box. I also have a button, wich I wanna asign an event on click.
I want this event to be able to show the selections the user did (combobox and multi selections on List box) in another Form to make a little table with more fields and more info.
This is the code i have so far, and trows me an "3265" error.
Any ideas?
Private Sub Command129_Click()
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim varItem As Variant
Dim strCriteria As String
Dim strSQL As String
Set db = CurrentDb()
Set qdf = db.QueryDefs("tblConfig Query")
For Each varItem In Me!List126.ItemsSelected
strCriteria = strCriteria & ",'" & Me!List126.ItemData(varItem) & "'"
Next varItem
If Len(strCriteria) = 0 Then
MsgBox "You did not select anything from the list" _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
strCriteria = Right(strCriteria, Len(strCriteria) - 1)
strSQL = "SELECT * FROM tblConfig " & _
"WHERE tblConfig.TypeConfig IN(" & strCriteria & ");"
qdf.SQL = strSQL
DoCmd.OpenQuery "tblConfig Query"
Set db = Nothing
Set qdf = Nothing
End Sub
Thanks
Related
I have created a form to get all the field header names, but I'm unable to select multiple fields. Attached is for your reference.
Following is the code used to get the Headers from the Master Table:
Private Sub Form_Load()
'Call GetColumnNameFromIndex
'Call List4_Click
Dim rst As New ADODB.Recordset
rst.Open "SELECT * FROM Master_DataBase", CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
' Note: adOpenForwardOnly and adLockReadOnly are the default values '
' for the CursorType and LockType arguments, so they are optional here '
' and are shown only for completeness '
Dim ii As Integer
Dim ss As String
For ii = 0 To rst.Fields.Count - 1
ss = ss & "," & rst.Fields(ii).Name
Next ii
Me.List4.RowSource = ss
Debug.Print ss
Me.Requery
End Sub
Set your properties to Simple or Extended.
Sample VBA code may look like this.
Option Compare Database
Private Sub cmdOpenQuery_Click()
On Error GoTo Err_cmdOpenQuery_Click
Dim MyDB As DAO.Database
Dim qdef As DAO.QueryDef
Dim i As Integer
Dim strSQL As String
Dim strWhere As String
Dim strIN As String
Dim flgSelectAll As Boolean
Dim varItem As Variant
Set MyDB = CurrentDb()
strSQL = "SELECT * FROM tblCompanies"
'Build the IN string by looping through the listbox
For i = 0 To lstCounties.ListCount - 1
If lstCounties.Selected(i) Then
If lstCounties.Column(0, i) = "All" Then
flgSelectAll = True
End If
strIN = strIN & "'" & lstCounties.Column(0, i) & "',"
End If
Next i
'Create the WHERE string, and strip off the last comma of the IN string
strWhere = " WHERE [strCompanyCountries] in (" & Left(strIN, Len(strIN) - 1) & ")"
'If "All" was selected in the listbox, don't add the WHERE condition
If Not flgSelectAll Then
strSQL = strSQL & strWhere
End If
MyDB.QueryDefs.Delete "qryCompanyCounties"
Set qdef = MyDB.CreateQueryDef("qryCompanyCounties", strSQL)
'Open the query, built using the IN clause to set the criteria
DoCmd.OpenQuery "qryCompanyCounties", acViewNormal
'Clear listbox selection after running query
For Each varItem In Me.lstCounties.ItemsSelected
Me.lstCounties.Selected(varItem) = False
Next varItem
Exit_cmdOpenQuery_Click:
Exit Sub
Err_cmdOpenQuery_Click:
If Err.Number = 5 Then
MsgBox "You must make a selection(s) from the list", , "Selection Required !"
Resume Exit_cmdOpenQuery_Click
Else
'Write out the error and exit the sub
MsgBox Err.Description
Resume Exit_cmdOpenQuery_Click
End If
End Sub
Please customize to your specific needs.
I have made this form in Access and I am hoping to do the following task.
The list box here contains two columns, and can be multi-selected. I want to use the values second column (the right column) and pass them into a query that I set up for the "test2" button below.
And here is my VBA code for the on-click event for the button.
Private Sub test2_Click()
Dim db As dao.Database
Dim qdef As dao.QueryDef
Dim strSQL As String
Set db = CurrentDb
'Build the IN string by looping through the listbox
For i = 0 To Select_Counties2.ListCount - 1
If Select_Counties2.Selected(i) Then
strIN = strIN & "'" & Select_Counties2.Column(1, i) & "',"
End If
Next i
'Create the WHERE string, and strip off the last comma of the IN string
strWhere = " WHERE County_GEOID in " & "(" & Left(strIN, Len(strIN) - 1) & ")"
strSQL = strSQL & strWhere
Set qdef = db.CreateQueryDef("User query results", strSQL)
qdef.Close
Set qdef = Nothing
Set db = Nothing
DoCmd.OpenQuery "User query results", acViewNormal
End Sub
I was getting this error:
Can someone tell me what I did wrong in the code? Thank you!
In this example from microsoft they call application.refreshwindow without explanation.
https://learn.microsoft.com/en-us/office/client-developer/access/desktop-database-reference/database-createquerydef-method-dao
What I think is going on is that your code fails because access cannot find the query that was just added to it's collection of queries. Also your generated sql is no longer valid.
So: replace my sql with your own valid sql
Private Sub test2_Click()
Dim db As DAO.Database
Dim qdef As DAO.QueryDef
Dim strSQL As String
strSQL = "PARAMETERS GEOID Number; " 'without valid sql this code doesn't run so
'replace my sql with your own.
strSQL = strSQL & "SELECT GEOID FROM Counties"
Set db = CurrentDb
For i = 0 To Select_Counties2.ListCount - 1
If Select_Counties2.Selected(i) Then
strIN = strIN & Select_Counties2.Column(1, i) & ","
End If
Next i
strWhere = " WHERE County_GEOID in " & "(" & Left(strIN, Len(strIN) - 1) & ")"
strSQL = strSQL & strWhere
Debug.Print strSQL
'now the important bit:
db.CreateQueryDef ("User query results") 'create the query
Application.RefreshDatabaseWindow 'refresh database window so access knows it has a new query.
'query will now be visible in database window. make sure to delete the query between runs
'Access will throw an error otherwise
Set qdef = db.QueryDefs("User query results")
qdef.SQL = strSQL
qdef.Close
Set qdef = Nothing
Set db = Nothing
DoCmd.OpenQuery "User query results", acViewNormal
End Sub
I'm trying to write some VBA to export filtered records from a subform. I've found a number of post related to this issue and I've cobbled the code below from those post.
When I run it I get a run-time error saying:
the Object '__temp' already exist.
When I click debug it highlights the line
Set qrydef = db.CreateQueryDef(strTempQryDef, strSQL)
Thank you for you help.
Private Sub ExportSubform()
Dim db As dao.Database
Dim qrydef As dao.QueryDef
Dim strSQL As String
Dim bolWithFilterOn As Boolean
Dim strTempQryDef As String
Dim strRecordSource As String
strTempQryDef = "__temp"
bolWithFilterOn = me.subsearch_frm.Form.FilterOn
strRecordSource = me.subsearch_frm.Form.RecordSource
If InStr(strRecordSource, "SELECT ") <> 0 Then
strSQL = strRecordSource
Else
strSQL = "SELECT * FROM [" & strRecordSource & "]"
End If
' just in case our sql string ends with ";"
strSQL = Replace(strSQL, ";", "")
If bolWithFilterOn Then
strSQL = strSQL & _
IIf(InStr(strSQL, "WHERE ") <> 0, " And ", " Where ") & _
me.subsearch_frm.Form.Filter
End If
Set db = CurrentDb
'create temporary query
Set qrydef = db.CreateQueryDef(strTempQryDef, strSQL)
db.QueryDefs.Append qrydef
Set qrydef = Nothing
DoCmd.TransferSpreadsheet TransferType:=acExport, _
SpreadsheetType:=acSpreadsheetTypeExcel12Xml, _
TableName:=strTempQryDef, _
FileName:=Replace(CurrentProject.Path & "\", "\\", "\") & strTempQryDef & ".xlsx"
' Delete the temporary query
db.QueryDefs.Delete strTempQryDef
Set db = Nothing
End Sub
Per the documentation:
If the object specified by name is already a member of the QueryDefs collection, a run-time error occurs.
As such, you should delete the temporary query before attempting to create it. To do this, you could use code along the lines of the following:
On Error Resume Next
DoCmd.DeleteObject acQuery, strTempQryDef
On Error GoTo 0
Also, per the documentation:
In a Microsoft Access workspace, if you provide anything other than a zero-length string for the name when you create a QueryDef, the resulting QueryDef object is automatically appended to the QueryDefs collection.
As such, you don't need this line:
db.QueryDefs.Append qrydef
I Am trying to run this SQL statement and then export the result to an excel spread sheet. I've looked through the the internet and found this, which seemed to work for other users.
It runs but asks me to "Enter Parameter Value" linking to "selecteduser" on line 4 of the code, the message box shows up at the point where the code starts here: DoCmd.TransferSpreadsheet. If I click ok the excel sheet is created but with nothing in except the titles from the selected columns from the tables in the database. If i put valid data into the text box and press ok, then the excel spreadsheet is created with the correct data showing.
I know that the selected data in the ComboBox is been stored, because if I do a Message box it shows the selected data from the combobox.
Any ideas anyone? It's obvious the data isn't been passed through somewhere, but I can't see where.
Private Sub Command12_Click()
Dim strSQL As String
Dim strQry As String
Dim selecteduser As String
Dim db As DAO.Database
Dim Qdf As QueryDef
selecteduser = Me.Combo6.Column(0)
strSQL = "SELECT tblPra.praNo, tblFolder.folder, tblFolder.fullTitle FROM tblPra INNER JOIN (tblFolder INNER JOIN tblRelationship ON tblFolder.folderID = tblRelationship.folderID) ON tblPra.praID = tblRelationship.praID WHERE (((tblPra.praNo)=selecteduser));"
strQry = "tempuser"
Set db = CurrentDb
Set Qdf = db.CreateQueryDef(strQry, strSQL)
On Error Resume Next
DoCmd.DeleteObject acQuery, "strQry"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, _
strQry, "C:\Users\prc93\Desktop\test.xls", True
DoCmd.DeleteObject acQuery, strQry
End Sub
the selecteduser in your query needs to be outside of the quotes. as it is a string it needs to be in single quotes like 'selecteduser'. Now if you msgbox your query and you should see that the selecteduser equals your column (0). are you sure that selecteduser needs to be a string and not a number e.g. long?
Private Sub Command12_Click()
Dim strSQL As String
Dim strQry As String
Dim selecteduser As String
Dim db As DAO.Database
Dim Qdf As QueryDef
selecteduser = Me.Combo6.Column(0)
strSQL = "SELECT tblPra.praNo, tblFolder.folder, tblFolder.fullTitle FROM " &_
"tblPra INNER JOIN (tblFolder INNER JOIN tblRelationship ON " &_
"tblFolder.folderID = tblRelationship.folderID) ON " &_
"tblPra.praID = tblRelationship.praID " &_
"WHERE (((tblPra.praNo)='" & selecteduser & "'));"
strQry = "tempuser"
Set db = CurrentDb
Set Qdf = db.CreateQueryDef(strQry, strSQL)
On Error Resume Next
DoCmd.DeleteObject acQuery, "strQry"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, _
strQry, "C:\Users\prc93\Desktop\test.xls", True
DoCmd.DeleteObject acQuery, strQry
End Sub
I have a userform with one textbox and one combobox in EXCEL.
This userform is connected to a small data base (one table with 2 columns)
Combobox is populated with the values from the first column of databasqe table
I like when the combobox is changing the textbox to be automatic populated with the corespondent value from the second column.
I have the following code but it is not working:
Please, can someone help me?
Sub PopulateTB()
Dim rs As Recordset
Dim db As database
Dim SQL As String
Set db = OpenDatabase(ThisWorkbook.Path & "\materiale.mdb")
SQL = "SELECT values_col2 FROM table_db WHERE values_col1 = " & UserForm1.ComboBox1.Value & ";"
Set rs = db.OpenRecordset(sql)
Do Until rs.EOF = True
UserForm1.TextBox1.Value = rs.Fields(SQL)
rs.MoveNext
Loop
rs.Close
Set db = Nothing
Set rs = Nothing
End Sub
Thank you!
I putted like this and it is ok
Sub PopulateTB(ByRef ctl As Control, ByVal strTable As String, ByVal strField As String, Optional ByVal strCriteria As String)
Dim strSQL As String
Dim strSQLcount As String
Dim rs As Recordset
Dim db As Database
Dim rsCount As Recordset, totalCol As Long
Dim varRecords As Variant
Set db = OpenDatabase(ThisWorkbook.Path & "\materiale.mdb")
strSQLcount = ""
strSQLcount = strSQLcount & " " & "SELECT COUNT(*) AS Total FROM " & "[" & strTable & "]"
Set rsCount = db.OpenRecordset(strSQLcount)
totalCol = rsCount!Total
rsCount.Close
Set rsCount = Nothing
strSQL = ""
strSQL = strSQL & " " & "SELECT" & "[" & strField & "]"
strSQL = strSQL & " " & "FROM " & "[" & strTable & "]"
Set rs = db.OpenRecordset(strSQL)
varRecords = rs.GetRows(totalCol)
ctl.Value = varRecords(0, Me.ComboBox1.ListIndex)
rs.Close
db.Close
Set db = Nothing
Set rs = Nothing
End Sub