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

equalizer88 · 05-07-2016, 07:59 PM

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!

Code:

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