Create sql query using listbox items

[mukeshpiplai]

I am new in vba and specially vba query. My question is following:-

I have a form named "frmCreateQry" which have following
FieldType FieldName
1. ComboBox cboSelectTblQry
2. ListBox lstSelectFrom
3. ListBox lstSelectTo
4. Button cmdMove
5. Button cmdExport

cboSelectTblQry rowsource have form Onload value. It contains all table names of my database. When I select any table name from this combobox then all related fields name display in lstSelectFrom (ListBox). If I select any fields from lstSelectFrom and click on cmdMove (Button) then selected fields moves to lstSelectTo.

My question is that I want to create query using lstSelectTo items/fields by clicking cmdExport (Button) and export this query to excel format.

Kindly tell me the process.

Thanks

[Seth Schrock]

You will need to loop through your list box's selected items and concatenate them into a string separated by commas. Then just get the name of the table from your combo box and you can build the query SQL string. To export it, I'm pretty sure that you have to then pass the SQL string to a querydef, save it and then export the query.

[mukeshpiplai]

I prepared this... but not working

Dim dbs As Database
Dim qdf As DAO.QueryDef
Dim Tbl As DAO.TableDef
Dim varItem As Variant
Dim strCriteria As String
Dim strSQL As String
 
Set dbs = CurrentDb()
Set qdf = dbs.CreateQueryDef("MyQry")
Set Tbl = dbs.CreateTableDef(Me.cboSelectTblQry.Value)
For Each varItem In Me!lstSelectTo.ItemsSelected
strCriteria = strCriteria & "," & Me!lstSelectTo.ItemData(varItem) & ""
Next varItem
If Len(strCriteria) = 0 Then
MsgBox "You did not select anything." _
, vbExclamation, "Nothing to find!"
 
Exit Sub
End If
 
strCriteria = Right(strCriteria, Len(strCriteria) - 1)
strSQL = "SELECT* FROM Tbl "
 
DoCmd.OpenQuery "MyQry"
Set db = Nothing
Set qdf = Nothing

[mukeshpiplai]

can you tell me the code as you described....

[Seth Schrock]

After line 21, put Debug.Print strCriteria and post the result (it will display in the immediate window. Press Ctrl + G if it isn't visible.). Then, your strSQL isn't accurate. Assuming that strCriteria is the WHERE clause, it would need to be

strSQL = "SELECT * FROM " & Me.cboSelectTblQry & " WHERE " & strCriteria

Then you need to edit the SQL of a query.

Set qdf = db.QueryDef("MyQry")
qdf.SQL = strSQL
qdf.Close

Now you can export the query. I use the DoCmd.TransferSpreadsheet method for which you can get the instructions from the MSDN website.

[mukeshpiplai]

debug.print strCriteria

result

Emp_Design,Emp_Gender,Emp_Lname,Emp_FName,ID,Offic e,UserDA



but error " Method or Data member not found" with following line

Set qdf = dbs.QueryDef("MyQry")

My Full code is:-

Dim dbs As Database
Dim qdf As DAO.QueryDef
Dim varItem As Variant
Dim strCriteria As String
Dim strSQL As String
 
Set dbs = CurrentDb()
 
For Each varItem In Me!lstSelectTo.ItemsSelected
strCriteria = strCriteria & "," & Me!lstSelectTo.ItemData(varItem) & ""
Next varItem
 
If Len(strCriteria) = 0 Then
MsgBox "You did not select anything." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
 
strCriteria = Right(strCriteria, Len(strCriteria) - 1)
Debug.Print strCriteria
strSQL = "SELECT * FROM " & Me.cboSelectTblQry & " WHERE " & strCriteria
 
Set qdf = dbs.QueryDef("MyQry")
qdf.sql = strSQL
qdf.Close
 
Set dbs = Nothing

[mukeshpiplai]

Hello seth,

I resolve previous error.. Now syntex error "3075"

i attached image for same here.

[Seth Schrock]

Sorry it has taken me so long to get back with you.

Now that you have resolved the previous error, please put a Debug.Print strSQL on line 22 and post back what it puts in the immediate window. Based on the error that you are receiving, there is a problem with your SQL string.

[ADezii]

I create the following simple Code Segment that will do exactly as you requested and will also allow for Spaces in Table and Field Names. For the sake of brevity and conciseness, I included neither Validation or Error Checking:

Dim strTableName As String
Dim strBaseSQL As String
Dim strCriteria As String
Dim varItem As Variant
Dim strSQL As String
Dim qdf As DAO.QueryDef
 
strTableName = Me![cboSelectTblQry]
strBaseSQL = "SELECT "
 
For Each varItem In Me![lstSelectTo].ItemsSelected
  strCriteria = strCriteria & "[" & Me![lstSelectTo].ItemData(varItem) & "],"
Next
 
strSQL = strBaseSQL & Left$(strCriteria, Len(strCriteria) - 1) & " FROM [" & strTableName & "]"
 
Set qdf = CurrentDb.CreateQueryDef("MyQry", strSQL)
 
RefreshDatabaseWindow
 
'All you have to do is Export MyQry here

[mukeshpiplai]

Thanks to Seth and ADezii...

ADezii code work fine after some editing.

But now one more problem is that...
After export in excel to MyQry, Date fields shows numerical format instead of Date Format in excel but date field shows correct date format in MyQry in query section.


Any Suggestion..

My Code is following:-

If cboFormat = "Excel" Then
Dim strTableName As String
Dim strBaseSQL As String
Dim strCriteria As String
Dim varItem As Variant
Dim strSQL As String
Dim qdf As DAO.QueryDef
Dim OutPut As String
 
 
For Each qdf In CurrentDb.QueryDefs
  If qdf.Name = "MyQry" Then
    DoCmd.DeleteObject acQuery, "MyQry"
     Exit For
  End If
Next
 
strTableName = Me![cboSelectTblQry]
strBaseSQL = "SELECT "
 
For Each varItem In Me![lstSelectTo].ItemsSelected
  strCriteria = strCriteria & "[" & Me![lstSelectTo].ItemData(varItem) & "],"
Next
 
If Len(strCriteria) = 0 Then
MsgBox "You did not select anything." _
, vbExclamation, "Nothing to find!"
Exit Sub
End If
 
strSQL = strBaseSQL & Left$(strCriteria, Len(strCriteria) - 1) & " FROM [" & strTableName & "]"
 
Set qdf = CurrentDb.CreateQueryDef("MyQry", strSQL)
 
OutPut = "D:/Export.xlsx"
DoCmd.TransferSpreadsheet acExport, , "MyQry", OutPut
MsgBox " File has been exported to " & OutPut
 
RefreshDatabaseWindow
End If
 
ExitSub:
    Exit Sub
ErrorHandler:
    Resume ExitSub