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

Question

我发现 VBA 代码（链接如下）在通过定义分隔符将数据从文本文件导入单独的单元格时非常有用。 当前代码允许指定单个文件并从中提取数据。我希望实现的是从多个文本文件中提取数据，并将每个文件中的数据添加到 excel 中的新行中。我在尝试在代码中添加循环来实现这一点时遇到了困难。

您能否建议如何实现这一目标？

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

结束宏： 错误转到 0 Application.ScreenUpdating = True 关闭 #1 ''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''' ' END 导入文本文件 ''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''' 结束子

非常感谢

Answer 1

设置： 在 test.txt 文件中：

在同一目录中创建了具有相同布局的其他文本文件。

在电子表格中 记下单元格列标题和活动单元格位置。

单个文件代码被包裹在读取多个文件的代码中然后调用单个文件代码。在这个例子中使用了所有的文本文件。 (test*.txt) 以 test 作为他们名字的开头。

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

上面的代码从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

最终结果将如下所示：