4

这是我迄今为止在文件夹中查找所有日志文件的代码。但是我需要能够在每个文件中找到一个特定的字符串，如果在一个文件中找到它，停止查找并退出循环并报告它所在的文件名。

似乎有很多不同的方法可以打开文件并搜索它，我不知道哪种方法最好，而且我通常不使用 VBA，但目前我只能使用它。

附带说明一下，最多有 36 个日志文件，每个文件最大为 5MB。

Sub StringExistsInFile()
    Dim TheString As String

    TheString = "MAGIC"

    Dim StrFile As String
    StrFile = Dir("c:\MyDownloads\*.log")
    Do While Len(StrFile) > 0
        'Find TheString in the file
        'If found, debug.print and exit loop
    Loop
End Sub

我找到了这段代码，但似乎在 2007+ 版本的 Excel VBA Application.FileSearch 中被淘汰：

Sub FindText()
'http://www.mrexcel.com/forum/excel-questions/68673-text-file-search-excel-visual-basic-applications.html

Dim i As Integer

'Search criteria
With Application.FileSearch
    .LookIn = "c:\MyDownloads" 'path to look in
    .FileType = msoFileTypeAllFiles
    .SearchSubFolders = False
    .TextOrProperty = "*MAGIC*" 'Word to find in this line
    .Execute 'start search

'This loop will bring up a message box with the name of
'each file that meets the search criteria
    For i = 1 To .FoundFiles.Count
        MsgBox .FoundFiles(i)
    Next i

End With

End Sub
4

4 回答 4

5

这段代码：

  • 查找所有*.log文件扩展名 C:\MyDownloads\

  • 打开每个*.log文件并读取每一行

  • 如果找到MAGIC，则在( + )中打印文件名theString   Immediate WidnowCTRLG

Sub StringExistsInFile()
    Dim theString As String
    Dim path As String
    Dim StrFile As String
    Dim fso As New FileSystemObject
    Dim file As TextStream
    Dim line As String

    theString = "MAGIC"
    path = "C:\MyDownloads\*.log"
    StrFile = Dir(path & "*.log")

    Do While StrFile <> ""

        'Find TheString in the file
        'If found, debug.print and exit loop

        Set file = fso.OpenTextFile(path & StrFile)
        Do While Not file.AtEndOfLine
            line = file.ReadLine
            If InStr(1, line, theString, vbTextCompare) > 0 Then
                Debug.Print StrFile
                Exit Do
            End If
        Loop

        file.Close
        Set file = Nothing
        Set fso = Nothing

        StrFile = Dir()
    Loop
End Sub
于 2013-07-25T15:14:38.263 回答
1

Application.FileSearch在 2007+ 版本的 Excel 中被删除。不久前，我发现了这个复制它的函数。我有时会使用它，但通常我认为我只是使用FileSystemObjector Dir。

Sub FileSearch()
'
' Example of FileSearchByHavrda procedure calling as replacement of missing FileSearch function in the newest MS Office VBA
' 01.06.2009, Author: P. Havrda, Czech Republic
'
Dim sDir As String
sDir = Range("K3").Value
Dim FileNameWithPath As Variant
Dim ListOfFilenamesWithParh As New Collection ' create a collection of filenames
Dim rCount As Long 'row counter
' Filling a collection of filenames (search Excel files including subdirectories)
Call FileSearchByHavrda(ListOfFilenamesWithParh, sDir, "*.xls", False)
' Print list to immediate debug window and as a message window
For Each FileNameWithPath In ListOfFilenamesWithParh ' cycle for list(collection) processing
Debug.Print FileNameWithPath & Chr(13)
'MsgBox FileNameWithPath & Chr(13)
rCount = Application.WorksheetFunction.CountA(Range("A:A")) + 1
ActiveSheet.Cells(rCount, 1).Value = FileNameWithPath

Next FileNameWithPath
' Print to immediate debug window and message if no file was found
If ListOfFilenamesWithParh.Count = 0 Then
Debug.Print "No file was found !"
MsgBox "No file was found !"
End If
End Sub
'//------------------------------------------------------------------------------------------------
Private Sub FileSearchByHavrda(pFoundFiles As Collection, pPath As String, pMask As String, pIncludeSubdirectories As Boolean)
'
' Search files in Path and create FoundFiles list(collection) of file names(path included) accordant with Mask (search in subdirectories if enabled)

' 01.06.2009, Author: P. Havrda, Czech Republic
'
Dim DirFile As String
Dim CollectionItem As Variant
Dim SubDirCollection As New Collection
' Add backslash at the end of path if not present
pPath = Trim(pPath)
If Right(pPath, 1) <> "\" Then pPath = pPath & "\"
' Searching files accordant with mask
DirFile = Dir(pPath & pMask)
Do While DirFile <> ""
pFoundFiles.Add pPath & DirFile 'add file name to list(collection)
DirFile = Dir ' next file
Loop
' Procedure exiting if searching in subdirectories isn't enabled
If Not pIncludeSubdirectories Then Exit Sub
' Searching for subdirectories in path
DirFile = Dir(pPath & "*", vbDirectory)
Do While DirFile <> ""
' Add subdirectory to local list(collection) of subdirectories in path
If DirFile <> "." And DirFile <> ".." Then If ((GetAttr(pPath & DirFile) And vbDirectory) = 16) Then SubDirCollection.Add pPath & DirFile
DirFile = Dir 'next file
Loop
' Subdirectories list(collection) processing
For Each CollectionItem In SubDirCollection
Call FileSearchByHavrda(pFoundFiles, CStr(CollectionItem), pMask, pIncludeSubdirectories) ' Recursive procedure call
Next
End Sub
于 2013-07-25T14:40:02.013 回答
0

我没有通过第二个答案，但在第一个答案中，有些地方有缺陷！在行中

路径 = "C:\MyDownloads\*.log"

不要使用“*.log”的东西，路径应该只是“C:\MyDownloads\”

于 2013-10-18T10:24:08.237 回答
0

尝试这个：

资料来源：https ://social.msdn.microsoft.com/Forums/en-US/62fceda5-b21a-40b6-857c-ad28f12c1b23/use-excel-vba-to-open-a-text-file-and-search- it-for-a-specific-string?forum=isvvba

Sub SearchTextFile()
     Const strFileName = "C:\test.txt"
     Const strSearch = "TEST"
     Dim strLine As String
     Dim f As Integer
     Dim lngLine As Long
     Dim blnFound As Boolean
     f = FreeFile
     Open strFileName For Input As #f
     Do While Not EOF(f)
         lngLine = lngLine + 1
         Line Input #f, strLine
         If InStr(1, strLine, strSearch, vbBinaryCompare) > 0 Then
             MsgBox "Search string found in line " & lngLine, vbInformation
             blnFound = True
             Exit Do
         End If
     Loop
     Close #f
     If Not blnFound Then
         MsgBox "Search string not found", vbInformation
     End If
 End Sub
于 2019-03-30T01:52:52.003 回答