在多个文件中筛选数据

hyf1279

数据是机器产生的txt文件，需要从中提取文件中的一些元件名称（ID)和测量数值分别放入第一列和第二列,第二个文件读取时可以依次靠后，也可以插入原数据右移
这是之前一位大侠提供的代码，但是运行结果是每次运行只能读第一个文件写入excel A列和B列，这样只能读取后需删除文件夹中的第一个文件，才插入两列，再运行。。。这样一个文件夹下上百文件需要运行上百次，很麻烦
自己不大懂，希望大侠们能帮忙修改下代码，运行一次能够把所有的文本全部读取，谢谢
代码如下：

Sub TQ()
Dim iPath, FileName As String
Dim TXTArr, CFArr, JGarr()
Dim N1, N2 As Integer
        iPath = "D:\data"
FileName = Dir(iPath & "\*.txt")
If FileName <> "" Then
    Do
        Open iPath & "\" & FileName For Input As #1
        istr = Replace(StrConv(InputB(LOF(1), 1), vbUnicode), "{", "")
        Close #1
        TXTArr = Split(istr, "}")
        For i = 0 To UBound(TXTArr)
                n = n + 1
                ReDim Preserve JGarr(1 To 2, 1 To n)
                N1 = InStr(TXTArr(i), "ID:")
                If N1 > 0 Then
                    jg1 = Trim(Mid(TXTArr(i), N1 + 3, 15))
                    JGarr(1, n) = Left(jg1, InStr(jg1, vbCrLf) - 1)
                End If
                N2 = InStr(TXTArr(i), "MESVAL:")
                If N2 > 0 Then
                    jg2 = Trim(Mid(TXTArr(i), N2 + 7, 20))
                    JGarr(2, n) = Left(jg2, InStr(jg2, vbCrLf) - 1)
                End If
        Next
        FileName = Dir
    Loop While FileName < ""
End If
Range("A1").Resize(UBound(JGarr, 2), 2) = WorksheetFunction.Transpose(JGarr)
End Sub