word vba Search files for string and save found filenames to new textfile

[equalizer88]

I'm trying to search text files in one folder for keyword and if present, then append the filename to a text file f9.txt.



so if filenames
f1.txt
f2.txt
f3.txt
f4.txt

and only f2 and f4 has keyword, then f9.txt will contain f2.txt and f4.txt

My VBA code is not finding the search term. I have tried selection.range, but don't know how to use it. I know its probably only 1-2 lines to change!

Sub Find_files_with_string_save_filenames()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String
Dim wdDoc As Document
Dim DestFileNum As Long
Dim sDestFile As String

'On Error GoTo ErrHandler
'http://www.xl-central.com/append-text-from-one-text-file-to-another.html

strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.txt", vbNormal)
sDestFile = "C:\Users\equalizer\Documents\Macros\f9.txt"

DestFileNum = FreeFile()
Open sDestFile For Append As DestFileNum

While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
  With wdDoc
    'StrFolder & strFile
    'Call your other macro or insert its code here
    '
    'Search for first instance of text, and if true, then do stuff
    'http://forums.whirlpool.net.au/archive/1687397
    Application.ScreenUpdating = False
    'Selection.HomeKey Unit:=wdStory 'what does this do?
    'Selection.WholeStory
    'With Range.Find
    With Selection.Find
      .ClearFormatting
      .Text = "first"
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
    End With
    If Selection.Find.Execute Then
       Print #DestFileNum, wdDoc.Name
              
    End If

    .Close SaveChanges:=False
  End With
  strFile = Dir()
Wend
Close #DestFileNum
    
    
Set wdDoc = Nothing
Application.ScreenUpdating = True
MsgBox "Completed...", vbInformation
'ErrHandler:
      'MsgBox "Error " & Err.Number & ": " & Err.Description
End Sub
 
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

[gmayor]

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):

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

[equalizer88]

Thank you. I just had to change a tiny assembly language program and it was a lot easier to decipher than these objects!

If I had word files and need to search for bold, etc, why does the search I used below not find the search term?

With Selection.Find
      .ClearFormatting
      .Text = "first"
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
    End With
    If Selection.Find.Execute Then
       Print #DestFileNum, wdDoc.Name
              
    End If

[gmayor]

Your original code seems to work for the example, though you have commented out one line that should remain. There will never be bold text in a text file. Text files don't support text formatting?

Sub Find_files_with_string_save_filenames()
    Application.ScreenUpdating = False
    Dim strFolder As String, strFile As String
    Dim wdDoc As Document
    Dim DestFileNum As Long
    Dim sDestFile As String

    strFolder = GetFolder
    If strFolder = "" Then Exit Sub
    strFile = Dir(strFolder & "\*.txt", vbNormal)
    sDestFile = strFolder & "\f9.txt"

    DestFileNum = FreeFile()
    Open sDestFile For Append As DestFileNum

    While strFile <> ""
        Set wdDoc = Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
        With wdDoc
            Application.ScreenUpdating = False
            Selection.HomeKey Unit:=wdStory 'what does this do? It starts the search from the start of the document.
            With Selection.Find
                .ClearFormatting
                .Text = "first"
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            If Selection.Find.Execute Then
                Print #DestFileNum, wdDoc.Name
            End If
            .Close SaveChanges:=False
        End With
        strFile = Dir()
    Wend
    Close #DestFileNum

    Set wdDoc = Nothing
    Application.ScreenUpdating = True
    MsgBox "Completed...", vbInformation
End Sub

Function GetFolder() As String
Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
End Function

If you were working with document files rather than text files then

While strFile <> ""
        Set wdDoc = Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
        With wdDoc
            Application.ScreenUpdating = False
            Selection.HomeKey Unit:=wdStory    'what does this do? It starts the search from the start of the document.
            With Selection.Find
                .ClearFormatting
                'find formatting
                .Font.Name = "Times New Roman"
                .Font.Bold = True
                .Font.Size = "12"
                
                .Text = "first"
                .Forward = True
                .Wrap = wdFindContinue
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            If Selection.Find.Execute Then
                Print #DestFileNum, wdDoc.Name
            End If
            .Close SaveChanges:=False
        End With
        strFile = Dir()
    Wend

[equalizer88]

I tried and tried but could get it to Selection or ActiveDocument.Content.Find to find keyword, but it doesn't work. Why??


Range worked here below. Question: Does this search for all occurrences of "first"? No way to stop at first occurrence with this method of searching, correct?

            With .Range.Find
              '.ClearFormatting
              .Forward = True
              .Wrap = wdFindContinue
              .Format = False
              .MatchCase = False
              .MatchWholeWord = False
              .MatchWildcards = False
             '.MatchSoundsLike = False
              .MatchAllWordForms = False
              .Text = "first"
              .Execute 'Replace:=wdReplaceAll
            If .Found = True Then
                Print #DestFileNum, wdDoc.Name
            End If
                         
            End With

So I tried to modify, but this didn't find keyword:

         Selection.HomeKey Unit:=wdStory 'what does this do? It starts the search from the start of the document.
            With Selection.Find
              '.ClearFormatting
              .Forward = True
              .Wrap = wdFindContinue
              .Format = False
              .MatchCase = False
              .MatchWholeWord = False
              .MatchWildcards = False
             '.MatchSoundsLike = False
              .MatchAllWordForms = False
              .Text = "first"
              .Execute 'Replace:=wdReplaceAll
            If .Found = True Then
                Print #DestFileNum, wdDoc.Name
            End If
                         
            End With

I also tried ActiveDocument.Content.Find, but it didn't find keyword either.

             With ActiveDocument.Content.Find
              '.ClearFormatting
              .Forward = True
              .Wrap = wdFindContinue
              .Format = False
              .MatchCase = False
              .MatchWholeWord = False
              .MatchWildcards = False
             '.MatchSoundsLike = False
              .MatchAllWordForms = False
              .Text = "first"
              .Execute 'Replace:=wdReplaceAll
            If .Found = True Then
                Print #DestFileNum, wdDoc.Name
            End If
                         
            End With

[gmayor]

I have lost track of what we are trying to do. The first example I quoted will work for text files, the following does the same thing for DOC/DOCX format files (using your getfolder function)

Option Explicit
Sub Find_files_with_string_save_filenames()
Dim wdDoc As Document
Dim oRng As Range
Dim strFile As String
Dim strPath As String
Dim fso As Object
Dim oFile As Object
Const strFindText As String = "first"

    strPath = GetFolder
    If strPath = "" Then Exit Sub
    On Error Resume Next
    Kill strPath & "\f9.txt"
    On Error GoTo 0

    strFile = Dir(strPath & "\*.doc", vbNormal)

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set oFile = fso.CreateTextFile(strPath & "\f9.txt")
    While strFile <> ""
        Set wdDoc = Documents.Open(Filename:=strPath & "\" & strFile, _
                                   AddToRecentFiles:=False, _
                                   ReadOnly:=True, _
                                   Visible:=False)
        For Each oRng In wdDoc.StoryRanges 'It's a document so look in all story ranges
            With oRng.Find
                .Font.Bold = True 'Find the string only if it is bold
                Do While .Execute(FindText:=strFindText)
                    oFile.WriteLine strFile
                    Exit Do    'search text found so stop looking
                    Exit For    'and don't look in any more ranges
                Loop
            End With
            DoEvents
        Next oRng
        wdDoc.Close 0
        strFile = Dir$()
    Wend
    oFile.Close
    MsgBox "Completed...", vbInformation
lbl_Exit:
    Set oRng = Nothing
    Set wdDoc = Nothing
    Set fso = Nothing
    Set oFile = Nothing
    Exit Sub
End Sub

[equalizer88]

I typed data in word file (test.docm) and tried running following code. It works by searching data in current word file from where the VBA is running. If I copied this exact search to my code with files it doesn't work if I delete data from the test.docm file. I'm thinking that Selection in my code on first post is searching the test.docm data and not looking in the text files?? However, Range is searching the text files in folder.

Sub SearchFN()
    Dim iCount As Integer

    'Always start at the top of the document
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .ClearFormatting
        .Text = "1"
        '.Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .Execute
    End With
    
        If Selection.Find.Found Then
            MsgBox "Found"
        End If
    
End Sub

[equalizer88]

gmayor,

I'm just being hardheaded. I just am trying to figure out why selection.find.found is not working on external files, but works on local data in word document. Please look at post 7.

[equalizer88]

Ok, figured out problem was difference between Select and Range properties. I was missing the wdDoc.Select inside the With wdDoc loop. That is why the search was not looking in external files.

So why does the Range Object With .Range.Find not require specifying the external file? (Such as wdDoc.Range)

    While strFile <> ""
        Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
        With wdDoc
            Application.ScreenUpdating = False
'  **************************
 wdDoc.Select 'this was missing line 
' ***************************
     Selection.HomeKey Unit:=wdStory     ' It starts the search from the start of the document.
            'With .Range.Find 
' ****************************************
' if .Range.Find is used then no selection of WdDoc is required
'*****************************************
            With Selection.Find
              '.ClearFormatting
              .Forward = True
              .Wrap = wdFindContinue
              .Format = False
              .MatchCase = False
              .MatchWholeWord = False
              .MatchWildcards = False
             '.MatchSoundsLike = False
              .MatchAllWordForms = False
              .Text = "first"
              .Execute 'Replace:=wdReplaceAll
          'If .Found = True Then
            If Selection.Find.Found = True Then
                Print #DestFileNum, wdDoc.Name
            End If
           End With
        .Close SaveChanges:=False
        End With
        strFile = Dir()
    Wend
 ......

[gmayor]

Obviously you need to select something before you can use selection, but with ranges you don't need to select them, which is one of their main advantages. In the case of the code. The range is already referred to the document

With wdDoc
    With .Range.Find