Question

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

我需要提取多个文本文件。但是我只需要将某些数据（例如DATE-TIME）放置在第一列中，并将CARD NUMBER放置在第二列中。从此线程>> Extract a single line of data from numerous text files and import into Excel获得了代码，但我的输出仅显示文件中的第一个数据。请参阅下面的附件。

sample text

Output

Desired Output

这就是我所拥有的：

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

Answer 1

我为您修改了代码，它可以正常工作：

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

从文本文件提取数据到Excel

1 个答案: