CopyFromRecordset方法没有将光标移动到最后一行输出

时间:2013-05-28 13:33:31

标签: vba excel-vba ado ms-access-2003 excel

我使用ADO查询MS Access 2003中的表,并使用 CopyFromRecordset 方法将数据输出到Excel 2003工作表。

该表包含超过65536条记录,因此我无法使用 DoCmd.TransferSpreadsheet 并需要将VBA与ADO一起使用。

我的问题是,在调用 CopyFromRecordset 之后,即使只输出65536条记录,根据我的理解,光标仍然保持为1(AbsolutePosition = 1),光标应该是65537 ,准备下次调用 CopyFromRecordset

以下是我正在使用的代码:

Dim oXL As Excel.Application
Dim adoConn As ADODB.Connection
Dim adoRS As ADODB.Recordset
Dim iIndx As Integer

Dim blnMultipleSheets As Boolean

Set adoConn = New ADODB.Connection
Set adoRS = New ADODB.Recordset

With adoConn
    .CursorLocation = adUseClient
    .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=O:\Dev\Support\Recurring_Requests\Future_Deals_Notice_InterestValues_Rates_Data\Future Deals.mdb;Persist Security Info=False"
    .Open
End With

With adoRS
    .CursorType = adOpenForwardOnly
    .ActiveConnection = adoConn
    .CursorLocation = adUseClient
    .Source = "SELECT * FROM Future_Deals_InterestValues_Rates_Data"
    .Open
End With

Set oXL = New Excel.Application

With oXL
    If .Version < 12 Then
        blnMultipleSheets = True
    Else
        blnMultipleSheets = False
    End If

    .Visible = True
    .Workbooks.Add

    .Range("B2").CopyFromRecordset adoRS
    If adoRS.RecordCount > .ActiveSheet.Rows.Count Then
        Do While Not adoRS.EOF
            .Sheets.Add
            Range("B2").CopyFromRecordset adoRS
        Loop
    End If
End With

所以我在这里错过了什么?

2 个答案:

答案 0 :(得分:1)

这就是我使用的:

Dim iRow, iColumn, iSheet As Integer

iSheet = 1
iRow= 1

With oLibrExce
        .Visible = True
        .Workbooks.Add

    While Not record.EOF
        .Worksheets.Add
        Set oHojaExce = .ActiveWorkbook
        With oHojaExce.Worksheets(1)
            .Activate
            .Name = tableName & iSheet 
            For iColumn = 0 To cantidadColumnas - 1
                .cells(1, iColumn + 1) = Columnas(iColumn)
                .cells(1, iColumn + 1).Font.Bold = True
                If TipoColumnas(iColumn) = "DATE" Then
                    .Columns(iColumn + 1).Select
                    .Columns(iColumn + 1).NumberFormat = "m/d/yyyy"
                End If
                If TipoColumnas(iColumn) = "NUMBER" Then
                    .Columns(iColumn + 1).Select
                    .Columns(iColumn + 1).NumberFormat = "0.00"
                End If
            Next
            .range("A2").copyfromrecordset record, 1048576
            iSheet = iSheet + 1
        End With
        .cells.EntireColumn.AutoFit
        .cells(1, 1).Select
    Wend
End With

答案 1 :(得分:0)

这一行

.Range("B2").CopyFromRecordset adoRS

将整个记录集粘贴到B2处作为左上角坐标。

所以,删除你的循环和上面一行。

你可以像这样循环记录集(伪代码):

Function pasteRecordSet(ByRef adoRS)
    For i = 1 To adoRS.RecordCount
        If i > 65536 Then
            new sheet
            + you can call here recursively
        Else ' on the current sheet
            adoRS.MoveNext
            If (adoRS.EOF) Then
                adoRS.MoveFirst
            End If
    Next i
End Function