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