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

时间:2018-11-09 03:40:44

标签: sql sql-server excel vba excel-vba

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

我正在尝试在将其粘贴到Excel之前找出是否有一种拆分ADODB Recordset的方法。

这是我的代码,用于将数据从SQL提取到Excel:

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

感谢您的帮助人员。预先感谢。

1 个答案:

答案 0 :(得分:0)

您可以query the data and apply some filtering logic

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

或者,使用文件拆分工具(例如thisthis)。

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

第1步

另存为,扩展名为.xlsm的工作簿(启用了宏)

第二步

  1. ALT + F11 打开Visual Basic

  2. 插入>模块并将以下代码粘贴到右侧(来自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
  1. ALT + Q 关闭Visual Basic

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