从大量文本文件中提取数据到Excel

Question

I came across the VBA code (linked below) that I found very useful in importing data from text files into separate cells by defining a separator. The current code allows a single file to be specified and the data extracted from it. What I'm hoping to achieve is to extract data from a number of text files and adding the data from each file into a new row in excel. I'm having difficulties trying to add a loop into the code to achieve this.

Would you be able to advise how this could be achieved?

http://www.cpearson.com/excel/ImpText.aspx

Sub ImportTextFile()

Dim RowNdx As Long
Dim ColNdx As Integer
Dim TempVal As Variant
Dim WholeLine As String
Dim Pos As Integer
Dim NextPos As Integer
Dim SaveColNdx As Integer

FName = "C:\Users\40044600\Documents\zdump\"
MyFile = Dir(FName & "*.txt")
Sep = vbLf

SaveColNdx = ActiveCell.Column
RowNdx = ActiveCell.Row

Do While MyFile <> ""
    Open (FName & MyFile) For Input As #1

    While Not EOF(1)
        Line Input #1, WholeLine
        If Right(WholeLine, 1) <> Sep Then
            WholeLine = WholeLine & Sep
        End If
        ColNdx = SaveColNdx
        Pos = 1
        NextPos = InStr(Pos, WholeLine, Sep)
        While NextPos >= 1
            TempVal = Mid(WholeLine, Pos, NextPos - Pos)
            Cells(RowNdx, ColNdx).Value = TempVal
            Pos = NextPos + 1
            ColNdx = ColNdx + 1
            NextPos = InStr(Pos, WholeLine, Sep)
        Wend
        RowNdx = RowNdx + 1
    Wend
    Close #1
    MyFile = Dir()
    Debug.Print text
Loop

EndMacro: On Error GoTo 0 Application.ScreenUpdating = True Close #1 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' END ImportTextFile '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' End Sub

Many thanks

Answer 1

Setup: In a test.txt files:

Other text files with the same layout were created in the same directory.

In a spreadsheet note the cell column headings and active cell location.

The single file code is wrapped in code that reads multiple files then calls the single file code. In this example uses all the text files. ( test*.txt ) with test for the start of their name.

Sub TxtFiles()
    Dim strFileName As String
    Dim strFolder As String
    Dim strFileSpec As String

    'TODO: Specify path spec
    strFolder = "C:\Users\007\Documents\Programming\VBA\Excel"
    'TODO: Specify file spec
    strFileSpec = strFolder & "\test*.txt"

    strFileName = Dir(strFileSpec)
    Do While Len(strFileName) > 0
        Call ImportTextFile(strFileName, "|")
        'move active cell location to next available empty cell row in column A.
        Range("A1").End(xlDown).Offset(1, 0).Select
        'Read next filename
        strFileName = Dir
    Loop
End Sub

The above code calls the following code from ImportTextFile :

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ImportTextFile
' This imports a text file into Excel.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Sub ImportTextFile(FName As String, Sep As String)

    Dim RowNdx As Long
    Dim ColNdx As Integer
    Dim TempVal As Variant
    Dim WholeLine As String
    Dim Pos As Integer
    Dim NextPos As Integer
    Dim SaveColNdx As Integer

    Application.ScreenUpdating = False
    On Error GoTo EndMacro:

    SaveColNdx = ActiveCell.Column
    RowNdx = ActiveCell.Row

    Open FName For Input Access Read As #1

    While Not EOF(1)
        Line Input #1, WholeLine
        If Right(WholeLine, 1) <> Sep Then
            WholeLine = WholeLine & Sep
        End If
        ColNdx = SaveColNdx
        Pos = 1
        NextPos = InStr(Pos, WholeLine, Sep)
        While NextPos >= 1
            TempVal = Mid(WholeLine, Pos, NextPos - Pos)
            Cells(RowNdx, ColNdx).Value = TempVal
            Pos = NextPos + 1
            ColNdx = ColNdx + 1
            NextPos = InStr(Pos, WholeLine, Sep)
        Wend
        RowNdx = RowNdx + 1
    Wend

EndMacro:
    On Error GoTo 0
    Application.ScreenUpdating = True
    Close #1
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' END ImportTextFile
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub

The end result will look like: