ms-access - Trying to copy an Excel sheet to another workbook from within Access

Question

I'm trying to copy an excel worksheet to another workbook from within Access and keep getting the subscript out of range error. I've tried a few different things but can't seem to nail it. Any help would be appreciated. Using Access and Excel 2010 and my code is as follows:

Dim strTaxMonth As String
Dim strTaxYear As String
Dim strTabName As String
Dim objExcel As Excel.Application
Dim objWB As Workbook
Dim objWS As Worksheet
Dim strExcelFile0 As String
Dim strExcelFile1 As String
Dim strExcelFile2 As String

strTaxMonth = Forms!frm_PayrollTax_Report!ReportMonth
strTaxYear = Forms!frm_PayrollTax_Report!ReportYear
strTabName = strTaxMonth & strTaxYear & "_PTAX"
strExcelFile0 = "C:\File0.xlsm"
strExcelFile1 = "C:\File1.xlsx"
strExcelFile2 = "C:\File2.xlsm"


'Copy Worksheet to Yearly File


Set objExcel = New Excel.Application
objExcel.Visible = True
objExcel.DisplayAlerts = False

If Len(Dir(strExcelFile1)) > 0 Then Kill strExcelFile1

Set objWB = objExcel.Workbooks.Open(strExcelFile0)
objWB.Activate
Set objWS = objExcel.Sheets("PTAX")
objWS.Activate
objWS.Unprotect
objWS.Select
objWS.Name = strTabName
objWS.Range("A1:I16").Select
objWS.Range("A1:I16").Copy
objWS.Range("A1:I16").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
objWS.Range("B19:I28").Select
objWS.Range("B19:I28").Copy
objWS.Range("B19:I28").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
objWS.Protect
objWS.Select
objExcel.Workbooks.Open(strExcelFile0).Sheets(strTabName).Copy After:=objExcel.Workbooks.Open(strExcelFile2).Sheets("YTD PTAX")
objExcel.Workbooks(strExcelFile0).Activate
objExcel.ActiveWorkbook.SaveAs strExcelFile1
objExcel.ActiveWorkbook.Close False
objExcel.Quit
Set objExcel = Nothing
Set objWB = Nothing
Set objWS = Nothing

End Sub

Answer 1

只需使用这段代码

    Sub test()

     Dim xlapp as New Excel.Application
     Dim xlwkb as Workbook
     Dim xlsht as Worksheet
     Dim xlwkb2 as Workbook
     Dim xlsht2 as Worksheet

    xlapp.DisplayAlerts=False

    'First workbook and Sheet
        Set xlwkb=xlapp.Workbooks.Open(strExcelFile0)
        Set xlsht=xlwkb.Worksheets(1)

    'Second workbook and Sheet
        Set xlwkb2=xlapp.Workbooks.Open(strExcelFile0)
        Set xlsht2=xlwkb.Worksheets(1)

        xlsht.Range("A1:B16").Copy Destination:=xlsht2.Range("A1")

        Set xlsht=Nothing
        xlwkb.Close
        Set xlwkb=Nothing

        xlwkb2.Saveas "C:\File.xls"
        Set xlsht2=Nothing
        xlwkb2.Close

     xlapp.DisplayAlerts=True

        Set xlapp=Nothing
        xlapp.Quit

End Sub