Select Fields, Multi Select listboxes problem

[CamL]

Hi,

I want to combine the functionality of two sample databases found on this forum.
Select Fields_demo.mdb allows you to select fields from a list box.
Multi Select list boxes as criteria Access 2000. mbd allows you to make multiple selections on a query.

My knowledge of VB is limited. I have managed to to get the functionality of these tools working in my database but the results come out on two different tables when a run the query.

Any help on this would be much appreciated.

Thanks

 

[CamL]

Hi all,

I thought that I would paste in my code manipulation here. I know it is a mishmash.

I have three list boxes.

The first listbox, labelled 'Select fields from: qrySearch' selects for fields
The other two listboxes 'Customers' and 'Employees' selects on a query.

The listboxes are making thier selections properly but are working indpendently from each other. Meaning, when I press the search button two tables are returned. One with the columns selected and the other with the customers and employees selected. I want all this to be done together.

I know (or think I know) the reason two tables are being returned is that one part of the code is working independently from the other part. I've tried numerous ways to get the code working together but nothing has worked. I simply do not have the knowledge yet to get this working properly.

Any suggestions??

Option Compare Database
Option Explicit
Dim mQueryName As String
Private Sub Form_Load()
mQueryName = "qrySearch" ' <-- Specify table/query name here
 
lblSelect.Caption = "Select fields from: " & mQueryName
lstField.RowSourceType = "Field List"
lstField.RowSource = mQueryName
End Sub
Private Sub cmdRunQuery_Click()
If Me.lstCustomer.ItemsSelected.Count = 0 _
And Me.lstField.ItemsSelected.Count = 0 _
And Me.lstEmployee.ItemsSelected.Count = 0 Then
MsgBox "Make some selections first."
Exit Sub
End If
 
Dim db As DAO.Database
Dim qd As DAO.QueryDef
Dim varItem As Variant
Dim qDef As Object
Dim SQL As String
Dim sCustomer As String
Dim sEmployee As String
Dim sWhere As String
Dim vItem As Variant
 
' Loop through the list box to build the SELECT statement.
For Each varItem In lstField.ItemsSelected
SQL = SQL & "[" & lstField.ItemData(varItem) & "],"
Next varItem
' Exit if nothing is selected.
If SQL = "" Or SQL = "[]," Then Exit Sub
 
SQL = "SELECT " & Left(SQL, Len(SQL) - 1) & " From " & mQueryName
 
' Delete query Tempquery if it already exists.
Set db = CurrentDb
On Error Resume Next
db.QueryDefs.Delete "Tempquery"
On Error GoTo 0
 
' Create new Tempquery.
' (Tried Set qd = db.CreateQueryDef("", SQL), but error '7874')
Set qd = db.CreateQueryDef("Tempquery", SQL)
 
' Open Tempquery
DoCmd.OpenQuery qd.Name
 
' Delete Tempquery on exit
db.QueryDefs.Delete "Tempquery"
Set db = Nothing
 
'SELECT Orders.OrderID, Customers.ContactName, Employees.LastName, Orders.OrderDate
'FROM Employees INNER JOIN (Customers INNER JOIN Orders ON Customers.CustomerID =
'Orders.CustomerID) ON Employees.EmployeeID = Orders.EmployeeID;
 
SQL = "SELECT [Orders].[OrderID], [Customers].[ContactName]," & _
" [Employees].[LastName], [Orders].[OrderDate]" & _
" FROM [Employees] INNER JOIN ([Customers] INNER JOIN [Orders]" & _
" ON [Customers].[CustomerID] = [Orders].[CustomerID])" & _
" ON [Employees].[EmployeeID] = [Orders].[EmployeeID]"
 
If Me.lstEmployee.ItemsSelected.Count > 0 Then
For Each vItem In Me.lstEmployee.ItemsSelected
sEmployee = sEmployee & ",""" & Me.lstEmployee.ItemData(vItem) & """"
Next
sWhere = "WHERE [Employees].[LastName] IN (" & Mid(sEmployee, 2) & ")"
End If
If Me.lstCustomer.ItemsSelected.Count > 0 Then
For Each vItem In Me.lstCustomer.ItemsSelected
sCustomer = sCustomer & ",""" & Me.lstCustomer.ItemData(vItem) & """"
Next
sWhere = IIf(Len(sWhere) > 0, sWhere & " AND", " WHERE") & _
" [Customers].[ContactName] IN (" & Mid(sCustomer, 2) & ")"
End If
SQL = SQL & sWhere
 
Set qDef = CurrentDb.QueryDefs("qrySearch")
qDef.SQL = SQL
DoCmd.OpenQuery "qrySearch"
 
Set qDef = Nothing
End Sub
Private Sub cmdClear_Click()
Me.lstCustomer = Null
Me.lstEmployee = Null
Me.lstField = Null
 
End Sub