excel vba - 将.txt（制表符分隔）文件的文件夹导入下一个可用行

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