以下VB代码实现的是提取当前目录下的Table.txt数据，然后创建Format.txt文件，按特定格式提取数据保存到里面。
想要改造为自动扫描当前目录下的.txt文件，然后按扫描到的txt文件名创建_Format.txt后缀，然后按特定格式提取数据保存到里面。
比如：当前目录下有123Table.txt，adadf.txt，iiiiii.txt，运行exe后按特定格式提取数据，然后保存为123123Table_Format.txt，adadf_Format.txt，iiiiii_Format.txt。

Private Sub Click()
    FileName = App.Path & "\" & "Table.txt"
    If Dir(FileName) <> "" Then
        Open FileName For Binary As #1
        AllData$ = Input$(LOF(1), 1)
        Close #1
        arr = Split(AllData$, vbCrLf)
        FileNameNew = Replace(LCase(FileName), ".txt", "Format.txt")
        Dim sr1 As String
        Dim sr2 As String
        Dim sr3 As String
        Open FileNameNew For Output As #1
        For X = 0 To UBound(arr)
            If InStr(arr(X), "Register_Table") > 0 Then
                Print #1, "//" & arr(X)
                Print #1, "const REG_TAB m_reg_tab[]={"
                k = 0
            ElseIf Left(arr(X), 3) = "Reg" Then
                k = k + 1
                sr1 = Mid(arr(X), 5, 2)
                sr2 = Mid(arr(X), 10, 2)
                sr3 = Mid(arr(X), 14, 99)
                Print #1, "    {0x" & sr1 & ",0x" & sr2 & "},//" & sr3
            ElseIf InStr(arr(X), "Ram_Table") > 0 Then
                k = 0
                Print #1, "//" & arr(X)
                Print #1, "const RAM1_TAB m_ram1_tab[]={"
            ElseIf Left(arr(X), 4) = "Coef" Then
                k = k + 1
                sr1 = Mid(arr(X), 6, 2)
                sr2 = Mid(arr(X), 11, 6)
                sr3 = Mid(arr(X), 18, 99)
                Print #1, "    {0x" & sr1 & ",0x" & sr2 & "},//" & sr3
            ElseIf arr(X) = "" And k > 0 Then
                k = 0
                Print #1, "};"
            End If
        Next
        Close #1
    End If
End Sub

感谢回答，刚出门了，晚点回去我试试

您好，我试了编译会报Loop缺少Do,看前面已经是有Do While的了，麻烦帮忙看看是哪里出问题了呢，谢谢！
Private Sub Click()
    Dim Filename As String, TmpFN As String
    TmpFN = App.Path & "\" & "*.txt"            '所有的TXT文件
    Filename = Dir(TmpFN)                       '返回第一个
    Do While Filename <> ""                     '文件名不为空则循环
        '注意,DIR返回值没有路径
        Filename = App.Path & "\" & Filename    '组合文件路径及文件名
            '接你原来的处理过程
            'Filename 已经组合好了
        Open Filename For Binary As #1
        AllData$ = Input$(LOF(1), 1)
        Close #1
        arr = Split(AllData$, vbCrLf)
        FileNameNew = Replace(LCase(Filename), ".txt", "Format.txt")
        Dim sr1 As String
        Dim sr2 As String
        Dim sr3 As String
        Open FileNameNew For Output As #1
        For X = 0 To UBound(arr)
            If InStr(arr(X), "Register_Table") > 0 Then
                Print #1, "//" & arr(X)
                Print #1, "const REG_TAB m_reg_tab[]={"
                k = 0
            ElseIf Left(arr(X), 3) = "Reg" Then
                k = k + 1
                sr1 = Mid(arr(X), 5, 2)
                sr2 = Mid(arr(X), 10, 2)
                sr3 = Mid(arr(X), 14, 99)
                Print #1, "    {0x" & sr1 & ",0x" & sr2 & "},//" & sr3
            ElseIf InStr(arr(X), "Ram_Table") > 0 Then
                k = 0
                Print #1, "//" & arr(X)
                Print #1, "const RAM1_TAB m_ram1_tab[]={"
            ElseIf Left(arr(X), 4) = "Coef" Then
                k = k + 1
                sr1 = Mid(arr(X), 6, 2)
                sr2 = Mid(arr(X), 11, 6)
                sr3 = Mid(arr(X), 18, 99)
                Print #1, "    {0x" & sr1 & ",0x" & sr2 & "},//" & sr3
            ElseIf arr(X) = "" And k > 0 Then
                k = 0
                Print #1, "};"
            End If
        Filename = Dir()                        '下一个文件名
    Loop
End Sub

报错解决了，最后我漏了Next Close #1,验证完全符合需求，非常感谢大佬
        Next
        Close #1
        Filename = Dir()                        '下一个文件名
    Loop