Multi Select Combo Box Query to Export

JMarcus

Registered User.
Local time
Today, 06:07
Joined
Mar 30, 2016
Messages
89
I found this and think it is likely the method to run a query through a multi select combo box on a form and would like to know how to get it to expoert out with the docmd transferspreadsheet.

Private Sub cmdPrintLabels_Click()
Dim strSelected As String
Dim strWhere As String
Dim varSelected As Variant

If Len(Me!Textbox1 & vbNullString) = 0 Then
MsgBox "You must put something in Textbox 1"
Exit Sub
Else
strWhere = strWhere & "Field1 = '" & Me!Textbox1 & "' AND "
End If
If Len(Me!Textbox2 & vbNullString) > 0 Then
strWhere = strWhere & "Field2 = '" & Me!Textbox2 & "' AND "
End If
If Me!MyListbox.ItemsSelected.Count > 0 Then
For Each varSelected In Me!MyListbox.ItemsSelected
strSelected = strSelected & Me!MyListbox.ItemData(varSelected) & ", "
Next varSelected
strSelected = Left$(strSelected, Len(strSelected) - 2)
strWhere = strWhere & "Field3 In (" & strSelected & ") AND "
End If

' Remove the extraneous " AND " from the end of strWhere
strWhere = Left$(strWhere, Len(strWhere) - 5)

DoCmd.OpenReport "MyReport", acViewPreview, , strWhere

End Sub
 
I don't think you could apply docmd transferspreadsheet. to this but I think you could output the report to excel with this modified version of the code which uses DoCmd.OutputTo. Note that you would have to change "C:\Filename.xls" in this code you the path you want.

Code:
Private Sub cmdPrintLabels_Click()
Dim strSelected As String
Dim strWhere As String
Dim varSelected As Variant

If Len(Me!Textbox1 & vbNullString) = 0 Then
    MsgBox "You must put something in Textbox 1"
    Exit Sub
Else
    rWhere = strWhere & "Field1 = '" & Me!Textbox1 & "' AND "
End If
If Len(Me!Textbox2 & vbNullString) > 0 Then
    strWhere = strWhere & "Field2 = '" & Me!Textbox2 & "' AND "
End If
If Me!MyListbox.ItemsSelected.Count > 0 Then
    For Each varSelected In Me!MyListbox.ItemsSelected
        strSelected = strSelected & Me!MyListbox.ItemData(varSelected) & ", "
    Next varSelected
    strSelected = Left$(strSelected, Len(strSelected) - 2)
    strWhere = strWhere & "Field3 In (" & strSelected & ") AND "
End If

' Remove the extraneous " AND " from the end of strWhere
strWhere = Left$(strWhere, Len(strWhere) - 5)


'Output report to excel
DoCmd.OpenReport "MyReport", acViewReport, , strWhere, acHidden
DoCmd.OutputTo acOutputReport, "MyReport", acFormatXLS, "C:\Filename.xls"
DoCmd.Close acReport, "MyReport"

End Sub
 
That works great. Thanks. What if the report is too large too many records that you dont want to open it or preview it cause the db will just crash. Too many records but perfect for export it too excel.
 
I just dont want the report preview just the export excel. Report running sometimes 100,000 records will cause db to crash. I'll try to manipulate it to do it.
 
You could avoid the report by making a temporary table from your query and then you could use DoCmd.TransferSpreadsheet, but you would need to do compact and repair often to avoid bloat.

Below is some code that also avoids a report. It needs some work so far as error checking is concerned, but maybe this would work for you.


Code:
Public Sub ExportXLData(QueryName As String, xlFilePath As String, Optional xlSheetName As String = "Sheet1", Optional xlCell As String = "A1")

Dim wb As Object
Dim ws As Object
Dim XL As Object
Dim db As DAO.Database
Dim rs As DAO.Recordset

Set db = CurrentDb
Set rs = db.OpenRecordset(QueryName)
Set XL = CreateObject("Excel.Application")
Set wb = XL.Workbooks.Open(xlFilePath)
Set ws = wb.Sheets(xlSheetName)
ws.Range(xlCell).CopyFromRecordset rs
Set ws = Nothing
wb.Save
wb.Close
rs.Close
db.Close
Set wb = Nothing
Set XL = Nothing

End Sub
 
I have this working great however there are too many rows which exceeds the output in xls format. I would like to export them to xlsx 2010 format as well. What other options are available to get these unless using transferspreadsheet

Private Sub cmdOpenReport_Click()
On Error GoTo Err_cmdOpenReport_Click
Dim strWhere As String
Dim ctl As Control
Dim varItem As Variant
'make sure a selection has been made
If Me.PlanNames.ItemsSelected.Count = 0 Then
MsgBox "Must select at least 1 plan"
Exit Sub
End If
'add selected values to string
Set ctl = Me.PlanNames
For Each varItem In ctl.ItemsSelected
strWhere = strWhere & ctl.ItemData(varItem) & ","
Next varItem
'trim trailing comma
strWhere = Left(strWhere, Len(strWhere) - 1)


'Output report to excel
DoCmd.OpenReport "rptPlans", acPreview, , "ID IN(" & strWhere & ")"
DoCmd.OutputTo acOutputReport, "rptPlans", acFormatXLS, "F:\RptPlans.xls"
DoCmd.Close acReport, "rptPlans"
Exit_cmdOpenReport_Click:
Exit Sub
Err_cmdOpenReport_Click:
MsgBox Err.Description
Resume Exit_cmdOpenReport_Click
 
I tried that already. says it is not available. I wish it were that easy. How do I overcome the threshold.
 
what version of access are you using? also you need to change the file extension to .xlsx
 
Sorry about that. I just assumed acFormatXLSX would work as it is a valid constant. But I googled the "format not available" problem and it seems that it just doesn't work. It was never implemented by Microsoft. So it looks like you can't do this with DoCmd.OutputTo.
 
No problem. It just seems like there must be a way to transferspreadsheet.
 
try supplying the value of the constant acFormatXLSX. I assume something like "XLFormat(*.XLSX)"
 

Users who are viewing this thread

Back
Top Bottom