Question

＆＃39;目前我只能搜索1个.txt文件，并在单独的.txt文件中输出该值。＆＃39;需要帮助才能搜索多个.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

需要Excel宏的帮助来搜索多个.text / .data文件

1 个答案: