在Excel宏上需要幫助以搜索Mulltiple .txt / .dat文件

Question

'目前，我只能搜索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

Answer 1

1）使用文件名字符串作為參數將搜索代碼重寫為Sub

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