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

Question

I have a small macro program that extracts almost 2 million rows of data from SQL to Excel worksheet. But the problem is, each worksheet can only contain up to 1048576 rows, so it cuts my data.

I'm trying to figure out if there's a way to split the ADODB Recordset before you paste it to Excel.

Here's my code for extracting the data from SQL to Excel:

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

Appreciate your help guys. Thanks in advance.

Answer 1

You can query the data and apply some filtering logic .

You can try delimit , and manage up to 100 million rows.

Or, use a file splitting tool (like this or this ).

You can try a VBA solution as well.

step1

Save As, your Workbook with extension .xlsm (macros enabled)

step2

1. press ALT + F11 to open Visual Basic

2. Insert > module and paste the code below on the right (from 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

3. Press ALT + Q to Close Visual Basic

As a final thought, I'll say it may be time to move up to Python or R.