MS Access-CopyFromRecordset

问题描述

我正在使用以下代码从数据库中获取记录.我有超过 5,000,000 条记录.下面的代码提取 1048576 条记录并粘贴到 Sheet 2 中.有人可以帮我循环它，以便它提取所有记录并将其从 sheet1 放置而不是 sheet2 而不是 sheet3，直到所有记录都被粘贴.

I am using below code to fetch records from a db. I have more than 5,000,000 records. The below code pulls 1048576 records and pastes in Sheet 2. Can someone help me to loop it so that it pulls all records and places it from sheet1 than sheet2 than sheet3 until all records are pasted.

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 = "Sheet2"
Const conWKB_NAME = "\\workbook path\a\b\c\Work.xlsm"
  Set db = CurrentDb
  Set objXL = New Excel.Application
  Set rs = db.OpenRecordset("Database", 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

推荐答案

不是完整答案，因为不确定表的结构，但是使用带有主键的表，我做到了接下来，您需要对记录进行计数并根据此设置循环，但需要遵循以下几点

Not a full answer, as not sure of the structure of the table, but using a table with a primary key, I did the following, you'll need to do a count of the records and set the loop up according to that, but something along these lines

Sub test()

    Dim strsql As String
    Dim l As Long
    Dim x As Long  ' x will be recordcount/ l

    l = 10000   ' max rows

    For x = 1 To 3
        strsql = "select top " & l & " y.* from (" & _
                "Select top " & (x * l) & " * from [Table] order by [ID] desc" & _
                ") as Y order by y.id asc"
        Debug.Print strsql 
    Next x

    End Sub

这会像这样生成 SQL

This generates SQL like so

select top 10000 y.* from (Select top 10000 * from [Table] order by [ID] desc) as Y order by y.id asc
select top 10000 y.* from (Select top 20000 * from [Table] order by [ID] desc) as Y order by y.id asc
select top 10000 y.* from (Select top 30000 * from [Table] order by [ID] desc) as Y order by y.id asc

编辑

Sub test()

    Dim strsql As String
    Dim l As Long
    Dim x As Long  ' x will be recordcount/ l
    dim rst as adodb.recordset

    l = 10000

    For x = 1 To (dcount("id","table")/l)
        strsql = "select top " & l & " y.* from (" & _
                "Select top " & (x * l) & " * from [Table] order by [ID] desc" & _
                ") as Y order by y.id asc"
    set rst=new adodb.recordset
    rst.open strSQL, currentproject.connection, adOpenKeySet
        worksheets(x).range("a1").copyfromrecordset rst
    Next x

End Sub

希望能帮到你

这篇关于MS Access-CopyFromRecordset的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！