Splitting ADODB Recordset to Excel worksheet?

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
End With
Sheets("Data)").Range("A2").CopyFromRecordset oRecordSet

Appreciate your help guys. Thanks in advance.


1 Answers Splitting ADODB Recordset to Excel worksheet?

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.

https://sourceforge.net/projects/simpletextsplit/ https://www.makeuseof.com/tag/how-to-split-a-huge-csv-excel-workbook-into-seperate-files/

You can try a VBA solution as well.


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


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
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

'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
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.

4 months ago