将数据从 Access 2010 导出到 Excel 2013

Question

我正在使用记录集将数据从 Access 导出到 Excel 以将数据从 Access 查询传输到 Excel（因为我必须手动格式化，而不能使用 transferSpreadsheet 完成），而我正在使用代码

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

这工作正常，直到 3 张，但是当我启动第 4 张时（因为 Excel 默认有 3 张）

Set sheet4 = wb.Worksheets.Add

我收到一个错误提示

下标超出范围错误。

有人可以帮助我吗？

Answer 1

哪一行错误 - 添加工作表？

代码对我有用：

设置 Sheet4 = Sheets.Add

也许发布您的完整分析程序。

Answer 2

没有看到代码就不可能确定。也许工作表名称拼写错误。只是一个猜测。尝试下面的代码示例，了解如何执行此类任务的一些不同方法。

'************* 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 *****************