需要Excel宏的帮助来搜索Mulltiple.txt/.dat文件吗

'目前，我只能搜索1.txt文件，并在单独的.txt文件中输出值。 '需要帮助搜索多个.txt文件并在单独的文件中输出值吗

Option Explicit

Private CellRowCounter                          As Integer
Private CellValue                               As String
Private textline                                As String
Private sExtractFile                            As String
Private sLogFile                                As String

Private myFile                                  As String
Private bFirstLineExtract                       As Boolean
Private bFirstLineLog                           As Boolean

Sub Main()

Dim bFound                                  As Boolean

On Error GoTo Error:

'Open File to search
myFile = Application.GetOpenFilename()

bFirstLineExtract = True
bFirstLineLog = True
CellRowCounter = 2
bFound = False

'Get First Cell Value
CellValue = Cells(CellRowCounter, 1)

Do Until (CellValue = "") Or (CellValue = Null)

    Open myFile For Input As #1

    Do Until EOF(1)
        'Read the file per line
        Line Input #1, textline

        If InStr(textline, CellValue) Then
            sCreateExtract
            bFound = True
        End If

    Loop

    If bFound = False Then
        sCreateLog
    End If

    Close #1

    CellRowCounter = CellRowCounter + 1

    'Get Next Cell Value/s
    CellValue = Cells(CellRowCounter, 1)
Loop

Close #1

If bFirstLineExtract = False Then
    MsgBox "File Search Successfully completed!" & vbCrLf & vbCrLf & _
           "Please see the file below for extract: " & vbCrLf & vbCrLf & _
           sLogFile
End If

If bFirstLineLog = False Then
    MsgBox "File Search Successfully completed!" & vbCrLf & vbCrLf & _
           "Please see the file below for the list of IDs that are not found in the file: " & vbCrLf & vbCrLf & _
           sLogFile
End If

Exit Sub

Error:
MsgBox ("Error in Main subroutine - " & Err.Description)

End Sub


Sub sCreateExtract()

Dim ExtractFile                             As Integer
Dim iFileLocation                           As Integer

On Error GoTo Error

iFileLocation = InStrRev(myFile, "\")
sExtractFile = Left(myFile, iFileLocation) & "Documaker Extract " & Format(Now, "YYYYMMDD-HHmm") & ".txt"
ExtractFile = FreeFile

If bFirstLineExtract = True Then
    Open sExtractFile For Output As #ExtractFile
    Print #ExtractFile, textline
    Close #ExtractFile
    bFirstLineExtract = False
Else
    Open sExtractFile For Append As #ExtractFile
    Print #ExtractFile, textline
    Close #ExtractFile
End If

Exit Sub

Error:
MsgBox ("Error in sCreateExtract subroutine. - " & Err.Description)

End Sub


Sub sCreateLog()

Dim LogFile                                 As Integer
Dim iFileLocation                           As Integer

On Error GoTo Error

iFileLocation = InStrRev(myFile, "\")
sLogFile = Left(myFile, iFileLocation) & "Documaker Not Found IDs " & Format(Now, "YYYYMMDD-HHmm") & ".txt"
LogFile = FreeFile

If bFirstLineLog = True Then
    Open sLogFile For Output As #LogFile
    Print #LogFile, CellValue
    Close #LogFile
    bFirstLineLog = False
Else
    Open sLogFile For Append As #LogFile
    Print #LogFile, CellValue
    Close #LogFile
End If

Exit Sub

Error:
MsgBox ("Error in sCreateExtract subroutine. - " & Err.Description)

End Sub

---

1以文件名字符串为参数，将搜索代码重写为子文件

2使用Application.FileDialog重新格式化文件打开。。。这可以拾取同一目录中的多个文件

例如：

Sub test()
Dim MyFD As FileDialog, FN As String

    Set MyFD = Application.FileDialog(msoFileDialogFilePicker)
    With MyFD
        .AllowMultiSelect = True
        .Show
        If .SelectedItems.Count = 0 Then Exit Sub

        For Each FN In .SelectedItems
            DoMySearch FN
        Next FN

    End With
End Sub


Sub DoMySearch(Infile As String)
    Debug.Print Infile
    ' your search routine here
    ' you may want to hand over OutFile name as well and ensure that this Sub
    ' opens and appends OutFile rather than recreating it from scratch in each pass
End Sub

---

…那么问题出在哪里？搜索多个文件的哪一部分？您搜索过任何解决方案吗？实际上它可以工作，但一次只能搜索一个txt文件。只是想改进代码，使其能够搜索多个txt文件。嗨，迈克，谢谢你的回复，但不确定你的代码，对不起，我是新来的宏。那么你是如何想出你的示例代码的？基本上在你的代码中所有的事情都发生在Sub-Main中。。。将Sub-Main重写为Sub-DomainSearchMyFile作为字符串，删除GetOpenFileName语句并添加/启动子测试