試圖將Excel工作表從Access複製到另一個工作簿

Question

我試圖將Excel工作表從Access中複製到另一個工作簿，並不斷收到下標超出範圍錯誤。我已經嘗試了幾個不同的東西，但似乎不能釘它。任何幫助，將不勝感激。使用Access和Excel 2010和我的代碼如下：

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