我使用下面的代码从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
答案 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
希望这有帮助
答案 1 :(得分:0)
现在,或者可能永远不会在Excel中使用。考虑使用免费的SQL Server express或R,它也是免费的。