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

 

[Andrzejek]

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


I would be very tempted to:
Create a recordset based on :
strSQL = “SELECT * FROM PortalData WHERE [PortalData].[Company id] IN (" & strWhere & ")"
Either * of just the Fields you want to show
rst,Open strSQL

Start xlApp (Excel Application)

With xlApp
    [green]'Place Header row from recordset[/green]
    For i = 0 To rst.Fields.Count - 1
        .Sheets(1).Cells(1, i + 1) = rst.Fields(i).Name
    Next
[green]
    'Copy the records into cell A2 on Sheet1.[/green]
    .Sheets(1).Range("A2").CopyFromRecordset rst
End With

rst.Close

But I am sure there are other ways to do that, too.

Have fun.

---- Andy

 

[MrMode]

Thanks

I will try this and come back to you. What I am after is running the query that already sits behind the report pulling the records identified in the multi select list box, so i will see if this works

 

[MrMode]

Sorry, being thick, I don't get how to use the example you posted above.

Am I adding that to the end of the code above instead of the docmd reference? Could you hand hold me through how to use it?

I had a quick attempt but it is telling me variable xlApp not defined which has kind of got me stumped, not a good start!

 

[Andrzejek]

Give me your hand (and $20 ) and let's go:

In your IDE, go to: Tools - References... and find MicroSoft Excel 14.0 Object Library. Mark it and say OK
(I have Excel 2010, your version may be different)

In your General Dclaration place:[tt]
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet[/tt]

And in your code (assuming your have your rst ready):

Dim i As Integer

Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.ActiveSheet

With xlApp
    'Place Header row from recordset
    For i = 0 To rst.Fields.Count - 1
        .Sheets(1).Cells(1, i + 1) = rst.Fields(i).Name
    Next

    'Copy the records into cell A2 on Sheet1.
    .Sheets(1).Range("A2").CopyFromRecordset rst
End With

Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing

Have fun.

---- Andy

 

[Andrzejek]

Ooops, forgot this:

With xlApp[blue]
    .Visible = True[/blue][green]
    'Place Header row from recordset[/green]
    ...

Or you will never SEE your Excel on the screen :-(

Have fun.

---- Andy

 

[MrMode]

OK, brilliant I will try that now

Thanks very much!

 

[MrMode]

Hi, unsuccessful this end I am afraid.

A couple of question:

1. Where am I putting this code, behind a new command button or stirring it into the code for the existing command button?
2. How do I get the selected rows to populate the query that delivers the data required? - I am not sure how to ensure the rst are ready.

I know I am a noob, bear with me.

Thanks

 

[Andrzejek]

1. I would create a new button and put this code in there. Start clean.
2. You can Google on 'create recordset in access vba' and I would start with hard-coded values in your query. After successful run, I would work on constructing your [tt]strWhere[/tt] to use in SELECT statement, which you may already have working.

Have fun.

---- Andy

 

[MrMode]

Great

Will do. Thanks!

 

[MrMode]

Got it working but am getting an error:

"Method 'CopyFromRecordset' or 'Range' failed"

Below is the complete code

Private Sub Command41_Click()
On Error GoTo Command41_Click_Err
Dim dbs As DAO.Database
Dim rsSQL As DAO.Recordset
Dim strSQL As String
Dim strWhere As String
Dim ctl As Control
Dim varItem As Variant

Set dbs = CurrentDb

'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 a snapshot-type Recordset based on an SQL statement
strSQL = "SELECT * FROM [PortalData] WHERE [Company id] IN (" & strWhere & ")"
Set rsSQL = dbs.OpenRecordset(strSQL, dbOpenSnapshot)

Dim i As Integer

Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.ActiveSheet

With xlApp
.Visible = True
'Place Header row from recordset
For i = 0 To rsSQL.Fields.Count - 1
.Sheets(1).Cells(1, i + 1) = rsSQL.Fields(i).Name
Next

'Copy the records into cell A2 on Sheet1.
.Sheets(1).Range("A2").CopyFromRecordset rsSQL

End With

Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing

Command41_Click_Exit:
Exit Sub

Command41_Click_Err:
MsgBox Error$
Resume Command41_Click_Exit


End Sub

 

[MrMode]

Hmm, it also seems to be dropping the first of the selected records, and sometimes, only returns one of the records selected...

Argh

 

[Andrzejek]

Is it possible that this is the problem?

I would try to create a very small recordset, 3-4 fields (columns in Excel) with 5-7 records (rows in Excel) just to prove the concept. Use some simple (hard-coded) SELECT statement just to get something very small and simple. And some basic fields, like numbers and short text, avoid Memo fields, multi-value fields, etc.

Have fun.

---- Andy

 

[MrMode]

That could be an issue.

If I could run the original query and send that to excel the issue would go away.

Any idea how I get this:


'Open a snapshot-type Recordset based on an SQL statement
strSQL = "select * from portaldata where [PortalData].[Company id] IN(" & strWhere & ")"
Set rsSQL = dbs.OpenRecordset(strSQL, dbOpenSnapshot)

to be the query I already have firing to populate the report in the original question that can then be exported to excel?

Thanks

 

[Andrzejek]

Did you try something simpler and smaller just to ‘prove the idea’?

[green]'Open a snapshot-type Recordset based on an SQL statement
'strSQL = "select * from portaldata where [PortalData].[Company id] IN(" & strWhere & ")"[/green]
strSQL = "[blue]select Fld2, Fld2 from portaldata where [Company id] IN(1, 2, 3)[/blue]"
Set rsSQL = dbs.OpenRecordset(strSQL, dbOpenSnapshot)

Replace Fld2, Fld2 with 2 simple fields from your portaldata table.

Do you get this small data into Excel?

Have fun.

---- Andy

 

[MrMode]

Hi

Yes, it works fine, all records come across... Argh, is not possible to export records with large memo fields?

My query does not pull across large fields so if i could fire it in this procedure, we should be in good shape.

Thanks for you patience and help

 

[Andrzejek]

large memo fields" are a problem for Excel.
A cell in Excel can hold (source)

Total number of characters that a cell can contain 32,767 characters

Which is a lot less what Access can have in a memo field.


Have fun.

---- Andy

 

[MrMode]

Would exporting it as a CSV over come the Excel limitation issue?

 

[Andrzejek]

You may give it a try, but in my opinion: limitation is limitation, and no matter which way you go, Excel is still limited to what it can do/display.

Just for my own curiosity… Why would you want to display in Excel so much ‘stuff’ in one cell anyway? Even if you could, would you want to show to the user so much text that would probably take more than one screen (monitor size) to see? Unless the user would have 60” monitor set to very high resolution.


Have fun.

---- Andy

 

[MrMode]

Not my request, it is necessary as that is how everyone wants to carve out records and review them - go figure!

Would using something like this be possible and if so, how do I amend it to work with the code above?

large_text:
ActiveCell.Offset(0, x) = Left(rst.Fields(x), 60000) 'allows text > 3803 to go into the cell
Err.Clear
Debug.Print x, ActiveCell.Row
Resume Next

I know it is painful, but it is working except for these pesky memo fields.

Thanks again!