将 ADODB 记录集拆分为 Excel 工作表？

Posted 2023-03-24

【中文标题】将 ADODB 记录集拆分为 Excel 工作表？

【英文标题】：Splitting ADODB Recordset to Excel worksheet?

【发布时间】：2018-11-09 03:40:43

【问题描述】：

我有一个小宏程序，可以从 SQL 中提取近 200 万行数据到 Excel 工作表中。但问题是，每个工作表最多只能包含 1048576 行，所以它会削减我的数据。

我想弄清楚是否有办法在将 ADODB 记录集粘贴到 Excel 之前对其进行拆分。

这是我将数据从 SQL 提取到 Excel 的代码：

With oRecordSet
    .ActiveConnection = oDBConnection
    .Source = mysql
    .LockType = adLockReadOnly
    .CursorType = adOpenForwardOnly
    .Open
End With
Sheets("Data)").Range("A2").CopyFromRecordset oRecordSet

感谢您的帮助。提前致谢。

【问题讨论】：

我相信您正在寻找的术语是“分页”。

我不熟悉 VBA，但我明白你的意思。如果您使用脚本的限制然后记住最后一条记录或插入最后一条记录，无论您想为它做什么。然后将另一条记录粘贴或复制到另一张纸中。第一次执行完成后。

【参考方案1】：

你可以query the data and apply some filtering logic。

您可以尝试delimit，并管理多达 1 亿行。

或者，使用文件拆分工具（如this 或this）。

您也可以尝试 VBA 解决方案。

第一步

另存为，您的工作簿，扩展名为 .xlsm（启用宏）

第二步

按 ALT + F11 打开 Visual Basic

插入 > 模块并将下面的代码粘贴到右侧（来自Sub....End Sub）

Sub SplitTxt_01()

    Const HelperFile As String = "ABCD" '<<< temp. helper text file Name
    Const N As Long = 700000  '<<< split each txt in N rows, CHANGE
    Dim myPath
    myPath = "c:\Folder1\Folder2\" '<<< folder path, CHANGE
    Dim myFile
    myFile = "Data File.TXT" '<<< your text file. CHANGE txt file name as needed

    Dim WB As Workbook, myWB As Workbook
    Set myWB = ThisWorkbook
    Dim myWS As Worksheet
    Dim t As Long, r As Long
    Dim myStr
    Application.ScreenUpdating = False

    'split text file in separate text files
    myFile = Dir(myPath & myFile)
    Open myPath & myFile For Input As #1
    t = 1
    r = 1
    Do While Not EOF(1)
    Line Input #1, myStr
    If r > N Then
    t = t + 1
    r = 1
    End If
    Open myPath & HelperFile & t & ".txt" For Append As #2
    Print #2, myStr
    Close #2
    r = r + 1
    Loop
    Close #1

    'copy txt files in separate sheets
    For i = t To 1 Step -1
    Workbooks.OpenText Filename:=myPath & HelperFile & i & ".txt", DataType:=xlDelimited, Tab:=True
    Set WB = ActiveWorkbook
    Set rng = ActiveSheet.UsedRange
    Set myWS = myWB.Sheets.Add
    myWS.Name = HelperFile & i
    rng.Copy myWS.Cells(1, 1)
    WB.Close False
    Next
    myWB.Save

    'Delete helper txt files
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Fldr = Fso.GetFolder(myPath)
    For Each Filename In Fldr.Files
    If Filename Like "*" & HelperFile & "*" Then Filename.Delete
    Next
    Application.ScreenUpdating = True
End Sub

按 ALT + Q 关闭 Visual Basic

作为最后的想法，我会说可能是时候升级到 Python 或 R。