Question

我试图在vba 1048576行限制中拆分一个大尺寸的txt文件（大约300mb和1000万行）（每个1048576行到一个独立工作表）并且我正在使用这段代码：

Mytext= CreateObject("Scripting.FileSystemObject").OpenTextFile(filepath).ReadAll

问题是在某些计算机上我收到此错误：

Run-Time error '-2147417848 (80010108)':
Method 'ReadAll' of object 'ITextStream' failed

我不知道如何解决这个问题。有什么想法吗？

Answer 1

需要注意的一些要点： -

一次性阅读一个300MB的文件是一个很大的问题，我很惊讶它是否有效并且不会感到意外失败
根据我的经验，大小超过80-90 MB的Excel文件难以使用，除非您绝对不得不这样做，我建议将结果拆分为工作簿（Excel文件）而不是工作表（单个工作簿中的工作表））。

这很麻烦，但这需要一次完成一行。以下是打开文本文件并将 X 行数读入单独工作簿的示例。

Public Sub Sample()
Dim ObjFSO      As Object
Dim ObjTS       As Object
Dim AryData()   As String
Dim LngDataRow  As Long
Dim LngWkbkNo   As Long
Dim WkBk        As Workbook
Dim WkSht       As Worksheet

'This dictates how many rows should be in each workbook
ReDim AryData(100000)


'Open then file
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
    Set ObjTS = ObjFSO.OpenTextFile(ThisWorkbook.Path & "\SampleFile.txt")

        'Process each line
        Do Until ObjTS.AtEndOfStream

            'If we have filled up our array then we need to output it
            If LngDataRow > UBound(AryData, 1) Then
                LngWkbkNo = LngWkbkNo + 1
                Set WkBk = Application.Workbooks.Add
                    Set WkSht = WkBk.Worksheets(1)
                        WkSht.Range("A1:A" & UBound(AryData, 1) + 1) = AryData
                    Set WkSht = Nothing
                    WkBk.SaveAs ThisWorkbook.Path & "\" & Right("000" & CStr(LngWkbkNo), 3) & ".xlsx"
                    WkBk.Close 0
                Set WkBk = Nothing

                'Reset the array and go back to the start
                ReDim AryData(UBound(AryData, 1))
                LngDataRow = 0
            End If

            'Add a line from the file into the array
            AryData(LngDataRow) = ObjTS.ReadLine
            LngDataRow = LngDataRow + 1
            DoEvents
        Loop
    Set ObjTS = Nothing
Set ObjFSO = Nothing

'Put the final lines into a file
If AryData(0) <> "" Then
    LngWkbkNo = LngWkbkNo + 1
    Set WkBk = Application.Workbooks.Add
        Set WkSht = WkBk.Worksheets(1)
            WkSht.Range("A1:A" & UBound(AryData, 1) + 1) = AryData
        Set WkSht = Nothing
        WkBk.SaveAs ThisWorkbook.Path & "\" & Right("000" & CStr(LngWkbkNo), 3) & ".xlsx"
        WkBk.Close 0
    Set WkBk = Nothing
End If

MsgBox "Done"

End Sub

方法错误＆＃39; ReadAll＆＃39;对象＆＃39; ITextStream＆＃39;失败

1 个答案: