简体   繁体   中英

excel vba - import folder of .txt (tab delimted) files into next available row

I've been racking my brains trying to create a macro in excel which opens all .txt files in a specific folder and imports them into the next available row. The data is tab delimited, and the first file needs to be imported into cell B8, the next file B9, the next B10, etc.

I'm about 80% there with this code, but it's importing all data into one cell (B8), rather than tab delimited into rows (B8, C8, D8, E8, etc).

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

I suggest continuing as you mentioned in your comment, use Workbooks.OpenText to open each file and then copy each row from the opened workbook to the specified sheet.

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM