Microsoft Office Forums - View Single Post - [Solved] word vba Search files for string and save found filenames to new textfile

gmayor · 05-07-2016, 09:21 PM

It is not necessary to open the text files in Word, which would be painfully slow, to search for text within them. Try the following which, like your example, looks for the word 'first' (in lower case):

Code:

Option Explicit

Sub Find_files_with_string_save_filenames()
Dim strFile As String
Dim strFileContent As String
Dim strPath As String
Dim iFile As Integer
Dim fso As Object
Dim oFile As Object
Const strFindText As String = "first"

    strPath = BrowseForFolder
    strFile = Dir$(strPath & "*.txt")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oFile = fso.CreateTextFile(strPath & "f9.txt")
    While strFile <> ""
        iFile = FreeFile
        Open strPath & strFile For Input As #iFile
        strFileContent = Input(LOF(iFile), iFile)
        If InStr(1, strFileContent, strFindText) > 0 Then
            oFile.WriteLine strFile
        End If
        Close #iFile
        strFile = Dir$()
    Wend
    oFile.Close
    MsgBox "Search complete"
lbl_Exit:
    Set fso = Nothing
    Set oFile = Nothing
    Exit Sub
End Sub

Private Function BrowseForFolder(Optional strTitle As String) As String
'Graham Mayor
'strTitle is the title of the dialog box
Dim fDialog As FileDialog
    On Error GoTo err_handler
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With fDialog
        .Title = strTitle
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then GoTo err_handler:
        BrowseForFolder = fDialog.SelectedItems.Item(1) & Chr(92)
    End With
lbl_Exit:
    Exit Function
err_handler:
    BrowseForFolder = vbNullString
    Resume lbl_Exit
End Function