将文本文件中的数据提取到 Excel 中

我是 VBA 新手，所以完成我的任务是相当困难的。几天来一直在阅读和尝试来自不同线程的代码，但没有成功。所以我希望有人可以帮助我。

我有多个文本文件，需要从中提取数据。但我只需要将某些数据（例如日期时间）放在第一列中，将卡号放在第二列中。从该线程获取代码>>从众多文本文件中提取单行数据并导入到 Excel 中 https://stackoverflow.com/questions/28851974/extract-a-single-line-of-data-from-numerous-text-files-and-import-into-excel但我的输出仅显示文件中的第一个数据。请参阅下面的附件。

示例文本 https://i.stack.imgur.com/SKEYc.png

Output https://i.stack.imgur.com/OAD3W.png

所需输出 https://i.stack.imgur.com/VC7p4.png

这是我所拥有的：

Sub ExtractData()
Dim filename As String, nextrow As Long, MyFolder As String
Dim MyFile As String, text As String, textline As String, filedate As String
Dim filenum As Integer

MyFolder = "C:\directory\"
MyFile = Dir(MyFolder & "*.txt")

Do While MyFile <> ""
    Open (MyFolder & MyFile) For Input As #1
    Do Until EOF(1)
        Line Input #1, textline
        text = text & textline

    Loop
    Close #1
    MyFile = Dir()
    Debug.Print text
    filedate = InStr(text, "DATE-TIME")
    nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
    ActiveSheet.Cells(nextrow, "A").value = Mid(text, filedate + 16, 17)

    filenum = InStr(text, "CARD NUMBER")
    nextrow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1
    ActiveSheet.Cells(nextrow, "B").value = Mid(text, filenum + 16, 10)
    text = ""  
Loop
End Sub

我给你修改一下代码，可以运行：

Sub ExtractData()
Dim filename As String, nextrow As Long, MyFolder As String
Dim MyFile As String, text As String, textline As String, filedate As String
Dim filenum As Integer
dim idx%

MyFolder = "C:\directory\"
MyFile = Dir(MyFolder & "*.txt")

nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1

Do While MyFile <> ""

    Open (MyFolder & MyFile) For Input As #1

    'nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1

    Do Until EOF(1)
        Line Input #1, textline 'read a line

        idx = InStr(textline, "DATE-TIME") ' if has date, set it but not move to the next ROW
        if idx > 0 then 
            ActiveSheet.Cells(nextrow, "A").value = Mid(textline, idx + 16)
        end if

        idx = InStr(textline, "CARD NUMBER")
        if idx > 0 then
            ActiveSheet.Cells(nextrow, "B").value = Mid(textline, filenum + 16)

            nextrow = nextrow + 1 'now move to next row

        end if

    Loop
    Close #1
    MyFile = Dir()

Loop
End Sub