オブジェクト 'ITextStream'のメソッド 'ReadAll'でエラーが発生しました。

Question

vba 1048576行の制限（1つの独立したシートに1048576行ごとに）で大きなサイズのtxtファイル（約300mbと1000万行）を分割しようとしています。私は、コードのこの部分を使用しています：

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

問題は一部のコンピュータでは、私はこのエラーを取得していますということです。

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

私はこの問題を解決する方法を知りません。 アイデア

Answer 1

注意すべき点がいくつかあり： -

• シングル回で300メガバイトのファイルを読んでいる大きな、私はそれは私の経験では
• を失敗驚いそれが今まで働いていた場合驚いているといない、頼みます80-90 MBを超えるExcelファイルは、絶対に必要な場合を除き、結果をワークブック（Excelファイル）に分割し、シート（単一のワークブック内のワークシート）に分割することをお勧めします。

これは煩雑ですが、一度に1行ずつ行う必要があります。以下は、テキストファイルを開き、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