Listbox select output to Excel

[amicar]

I have a multiselect listbox which is the result of a query.
When I select an item it opens Excel and exports 2 files that are unique to that list box item - doing this for all items selected.
When the code is run the first selected item performs the actions correctly.
On the next item it errors on on line:

XLApp.Sheets("Customer Used Hours").Copy After:=Workbooks("Customer Report - " & List65.Column(0) & ".xls").Sheets(1)

with the error :Run Time Errror 9 - Subscript out of range.

I don't think I am controlling Excel properly (opening,closing??).

Anyway, here is my code......



Option Compare Database
Option Explicit

Private Sub Command122_Click()

Dim vntIndex As Variant
Dim strValue As String

If List65.ListIndex < 0 Then
MsgBox "Please select 1 or more items from the list"
Exit Sub

End If

For Each vntIndex In List65.ItemsSelected
strValue = List65.ItemData(vntIndex)

DoCmd.OutputTo acQuery, "CUSTOMER REPORT", "MicrosoftExcelBiff8(*.xls)", "c:\Dell Easy Assist\Customers\Customer Report - " & List65.Column(0) & ".xls", False, "", 0
DoCmd.OutputTo acQuery, "Customer Used Hours", "MicrosoftExcelBiff8(*.xls)", "c:\Dell Easy Assist\Customers\Customer Used Hours.xls", False, "", 0


Dim XLApp As Object
Set XLApp = CreateObject("Excel.Application")


Dim FullPath As String
Dim FullPath1 As String

FullPath = "C:\Dell Easy Assist\Customers\Customer Report - " & List65.Column(0) & ".xls"
FullPath1 = "C:\Dell Easy Assist\Customers\Customer Used Hours.xls"

XLApp.Workbooks.Open (FullPath)
XLApp.Visible = False
XLApp.Workbooks.Open (FullPath1)
XLApp.Visible = False

XLApp.Sheets("Customer Used Hours").Copy After:=Workbooks("Customer Report - " & List65.Column(0) & ".xls").Sheets(1)

XLApp.ActiveWindow.TabRatio = 0.519
XLApp.ActiveWindow.ScrollWorkbookTabs Sheets:=-1

XLApp.Application.DisplayAlerts = False
XLApp.Application.Save
XLApp.Application.DisplayAlerts = True

XLApp.Application.Quit
XLApp.Quit

Set XLApp = Nothing

Kill "C:\Dell Easy Assist\Customers\Customer Used Hours.xls"

Next

MsgBox "Files have been saved in C:\Dell Easy Assist\Customers directory!"


End Sub

I am pretty new at Access VBA and have gotten a lot of information from this forum. An excellent source for amatuers like myself.
I appreciate any help given.

Many thanks.

 

[gecko_1]

Same Problem

Ive been trying to do somthing very similar.

And I was going to ask for help to, But I got it to work. My code does not do exaclty what amicar was after. This copies the same sheet twice to an empty workbook.

    Set xlx = CreateObject("Excel.Application")
    Set xlw = xlx.workbooks.Open(reportLoc())
    xlx.Visible = True

    xlw.worksheets("ITP").Copy
    xlw.worksheets("ITP").Copy After:=xlx.workbooks(2).worksheets(1) 

   'This was for my Testing only
    For i = 1 To xlx.workbooks.count
        Debug.Print i & " - " & xlx.workbooks(i).Name
    Next i    
    For i = 1 To xlw.worksheets.count
        Debug.Print xlw.worksheets(i).Name
    Next i

Hope that helps any one trying to do the same thing