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

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

1 个答案: