Excel VBA中 - .TXT（製表delimted）文件到下一個可用行

Question

我一直在絞盡腦汁試圖在Excel中創建的宏將打開所有.txt文件中的特定文件夾，並將它們導入到接下來的導入文件夾可用的行。數據是製表符分隔的，第一個文件需要導入到單元格B8，下一個文件B9，下一個B10等。

我用這個代碼約80％，但它將所有數據導入到一個單元格（B8），而不是製表符分隔成行（B8，C8，D8，E8等）。

Sub Read_Text_Files() 
Dim sPath As String, sLine As String 
Dim oPath As Object, oFile As Object, oFSO As Object 
Dim r As Long 
' 
'Files location 
sPath = "C:\Test\" 

'Text to Columns 
Range("A1", Range("A" & Cells.Rows.Count).End(xlUp)).Select 
Selection.TextToColumns DataType:=TabDelimited, TextQualifier:= _ 
     xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _ 
     Comma:=False, Space:=False, Other:=False 
Application.ScreenUpdating = True 

r = 8 
Set oFSO = CreateObject(_ 
"Scripting.FileSystemObject") 
Set oPath = oFSO.GetFolder(sPath) 
Application.ScreenUpdating = False 
For Each oFile In oPath.Files 

If LCase(Right(oFile.Name, 4)) = ".txt" Then 

Open oFile For Input As #1 

Do While Not EOF(1) ' Loop until end of file. 
Input #1, sLine ' Read data 
Range("B" & r).Formula = sLine ' Write data line 

r = r + 1 
Loop 
Close #1 ' Close file. 
' 
End If 
Next oFile 
End Sub 

Answer 1

我建議繼續爲您在您的評論中提到，使用Workbooks.OpenText打開每個文件，然後每行從打開的工作簿複製到指定的頁面。

Sub Read_Text_Files() 
    Dim sPath As String 
    Dim oPath, oFile, oFSO As Object 
    Dim r, iRow As Long 
    Dim wbImportFile As Workbook 
    Dim wsDestination As Worksheet 

    'Files location 
    sPath = "C:\Test\" 
    Set wsDestination = ThisWorkbook.Sheets("Sheet1") 

    r = 8 
    Set oFSO = CreateObject("Scripting.FileSystemObject") 
    Set oPath = oFSO.GetFolder(sPath) 
    Application.ScreenUpdating = False 
    For Each oFile In oPath.Files 
     If LCase(Right(oFile.Name, 4)) = ".txt" Then 
      'open file to impor 
      Workbooks.OpenText Filename:=oFile.Path, Origin:=65001, StartRow:=1, DataType:=xlDelimited, _ 
      TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, FieldInfo:=Array(1, 1), _ 
      TrailingMinusNumbers:=True 
      Set wbImportFile = ActiveWorkbook 
      For iRow = 1 To wbImportFile.Sheets(1).UsedRange.Rows.Count 
       wbImportFile.Sheets(1).Rows(iRow).Copy wsDestination.Rows(r) 
       r = r + 1 
      Next iRow 
      wbImportFile.Close False 
      Set wbImportFile = Nothing 
     End If 
    Next oFile 
End Sub