Exporting multiselect listbox directly to excel

[MrMode]

thread705-338328

I have a command on a form with a multi select list box (simple) which runs a report based on a query populated with values pulled from the selection made in the list box.

What I would prefer to do is export the query to excel and open the spreadsheet all based on the click of the command, I know it requires me to provide instruction on the last line, but not even sure where to start ! ...

Here is the code I already have that works but requires the user to export a report to excel and then open the spreadsheet.

Private Sub Command16_Click()
On Error GoTo ErrorHandler

Dim strWhere As String
Dim ctl As Control
Dim varItem As Variant

'make sure a selection has been made
If Me.List12.ItemsSelected.Count = 0 Then
MsgBox "Must select at least 1 company"
Exit Sub
End If

'add selected values to string
Set ctl = Me.List12
For Each varItem In ctl.ItemsSelected
strWhere = strWhere & ctl.ItemData(varItem) & ","
'Use this line if your value is text
'strWhere = strWhere & chr34 & ctl.ItemData(varItem) & chr34 & ","
Next varItem

'trim trailing comma
strWhere = Left(strWhere, Len(strWhere) - 1)

'open the report, restricted to the selected items
DoCmd.OpenReport "Report1", acPreview, , "[PortalData].[Company id] IN(" & strWhere & ")"

ExitHandler:

Exit Sub

ErrorHandler:
Select Case Err
Case Else
MsgBox Err.Description
DoCmd.Hourglass False
Resume ExitHandler
End Select


End Sub

 

[MrMode]

I have come up with an ugly work around - but it works.

What I need to do in order to finish it off is open the workbook once it has executed

    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 tbl1.[Company ID], tbl1.[Memo field] " & _
    "FROM tbl1"

    For i = 0 To Me.List12.ListCount - 1
        If Me.List12.Selected(i) Then
            If Me.List12.Column(0, i) = "All" Then
                flgSelectAll = True
            End If
            strIN = strIN & Me.List12.Column(0, i) & ","
        End If
    Next i
    strWhere = " WHERE [tbl1].[Company id] in " & _
               "(" & Left(strIN, Len(strIN) - 1) & ")"

    If Not flgSelectAll Then
        strSQL = strSQL & strWhere
    End If
    
    MyDB.QueryDefs.Delete "qryExportToExcel"
    Set qdef = MyDB.CreateQueryDef("qryExportToExcel", strSQL)

    Dim strQryName As String
    Dim strXLFile As String

    strQryName = "qryExportToExcel"

    strXLFile = "c:\users\xxxxx\documents\qryExportToExcel" & ".xls"

    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, strQryName, strXLFile

 

[PHV]

Something like this ?

...
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, strQryName, strXLFile
DoEvents
Set myWB = GetObject(strXLFile)
myWB.Application.Visible = True
...

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886