2017-03-08 159 views
0

我正在使用記錄集將數據從Access導出到Excel,以將訪問查詢中的數據傳輸到Excel(因爲我必須使用transferSpreadsheet無法完成的手動格式設置),同時我正在使用代碼將數據從Access 2010導出到Excel 2013

with sheet1 
.range("A2").CopyRecordset rs1 
End With 

這工作得很好,直到3張,但是當我開始第4片(以Excel默認有3張)

Set sheet4 = wb.Worksheets.Add 

我收到一個錯誤說

下標超出範圍錯誤。

有人可以幫我解決這個問題嗎?

回答

0

哪一行錯誤 - 添加工作表?

代碼工作對我來說:

設置Sheet4 = Sheets.Add

也許發表您的全過程進行分析。

+0

嗨,六月,看起來像我加錯了方式。 –

0

沒有看到代碼,無法肯定地說。也許工作表名稱拼寫錯誤。只是一個猜測。嘗試下面的代碼示例以瞭解如何執行此類任務的一些不同方法。

'************* Code Start ***************** 
'This code was originally written by Dev Ashish 
'It is not to be altered or distributed, 
'except as part of an application. 
'You are free to use it in any application, 
'provided the copyright notice is left unchanged. 
' 
'Code Courtesy of 
'Dev Ashish 
' 
Sub sCopyFromRS() 
'Send records to the first 
'sheet in a new workbook 
' 
Dim rs As Recordset 
Dim intMaxCol As Integer 
Dim intMaxRow As Integer 
Dim objXL As Excel.Application 
Dim objWkb As Workbook 
Dim objSht As Worksheet 
    Set rs = CurrentDb.OpenRecordset("Customers", _ 
        dbOpenSnapshot) 
    intMaxCol = rs.Fields.Count 
    If rs.RecordCount > 0 Then 
    rs.MoveLast: rs.MoveFirst 
    intMaxRow = rs.RecordCount 
    Set objXL = New Excel.Application 
    With objXL 
     .Visible = True 
     Set objWkb = .Workbooks.Add 
     Set objSht = objWkb.Worksheets(1) 
     With objSht 
     .Range(.Cells(1, 1), .Cells(intMaxRow, _ 
      intMaxCol)).CopyFromRecordset rs 
     End With 
    End With 
    End If 
End Sub 

Sub sCopyRSExample() 
'Copy records to first 20000 rows 
'in an existing Excel Workbook and worksheet 
' 
Dim objXL As Excel.Application 
Dim objWkb As Excel.Workbook 
Dim objSht As Excel.Worksheet 
Dim db As Database 
Dim rs As Recordset 
Dim intLastCol As Integer 
Const conMAX_ROWS = 20000 
Const conSHT_NAME = "SomeSheet" 
Const conWKB_NAME = "J:\temp\book1.xls" 
    Set db = CurrentDb 
    Set objXL = New Excel.Application 
    Set rs = db.OpenRecordset("Customers", dbOpenSnapshot) 
    With objXL 
    .Visible = True 
    Set objWkb = .Workbooks.Open(conWKB_NAME) 
    On Error Resume Next 
    Set objSht = objWkb.Worksheets(conSHT_NAME) 
    If Not Err.Number = 0 Then 
     Set objSht = objWkb.Worksheets.Add 
     objSht.Name = conSHT_NAME 
    End If 
    Err.Clear 
    On Error GoTo 0 
    intLastCol = objSht.UsedRange.Columns.Count 
    With objSht 
     .Range(.Cells(1, 1), .Cells(conMAX_ROWS, _ 
      intLastCol)).ClearContents 
     .Range(.Cells(1, 1), _ 
     .Cells(1, rs.Fields.Count)).Font.Bold = True 
     .Range("A2").CopyFromRecordset rs 
    End With 
    End With 
    Set objSht = Nothing 
    Set objWkb = Nothing 
    Set objXL = Nothing 
    Set rs = Nothing 
    Set db = Nothing 
End Sub 

Sub sCopyRSToNamedRange() 
'Copy records to a named range 
'on an existing worksheet on a 
'workbook 
' 
Dim objXL As Excel.Application 
Dim objWkb As Excel.Workbook 
Dim objSht As Excel.Worksheet 
Dim db As Database 
Dim rs As Recordset 
Const conMAX_ROWS = 20000 
Const conSHT_NAME = "SomeSheet" 
Const conWKB_NAME = "c:\temp\book1.xls" 
Const conRANGE = "RangeForRS" 

    Set db = CurrentDb 
    Set objXL = New Excel.Application 
    Set rs = db.OpenRecordset("Customers", dbOpenSnapshot) 
    With objXL 
    .Visible = True 
    Set objWkb = .Workbooks.Open(conWKB_NAME) 
    On Error Resume Next 
    Set objSht = objWkb.Worksheets(conSHT_NAME) 
    If Not Err.Number = 0 Then 
     Set objSht = objWkb.Worksheets.Add 
     objSht.Name = conSHT_NAME 
    End If 
    Err.Clear 
    On Error GoTo 0 
    objSht.Range(conRANGE).CopyFromRecordset rs 
    End With 
    Set objSht = Nothing 
    Set objWkb = Nothing 
    Set objXL = Nothing 
    Set rs = Nothing 
    Set db = Nothing 
End Sub 
'************* Code End *****************