MS Access-CopyFromRecordset

时间:2017-06-27 11:14:57

标签: vba ms-access

我使用下面的代码从db中获取记录。我有超过5,000,000条记录。下面的代码在Sheet 2中提取了1048576个记录和粘贴。有人可以帮我循环它,以便它从sheet1中拉出所有记录并将它放在sheet2之后而不是sheet3,直到粘贴所有记录。

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

2 个答案:

答案 0 :(得分:0)

不是完整的答案,因为不确定表的结构,但是使用带有主键的表,我做了以下操作,你需要对记录进行计数并根据它设置循环,但沿着这些行

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

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

希望这有帮助

enter image description here

答案 1 :(得分:0)

现在,或者可能永远不会在Excel中使用。考虑使用免费的SQL Server express或R,它也是免费的。