Hi Guys
Season Greetings and Happy New Year
I've adapated the following below code from this forum
https://www.msofficeforums.com/word-...different.html
Code:
Option Explicit
Public FSO As Object 'a FileSystemObject
Public oFolder As Object 'the folder object
Public oSubFolder As Object 'the subfolders collection
Public oFiles As Object 'the files object
Dim i As Long, strNm As String, strFnd As String, strFile As String, strList As String
Sub FindTextInDocs()
' Minimise screen flickering
Application.ScreenUpdating = False
Dim StrFolder As String
' Browse for the starting folder
StrFolder = GetTopFolder
If StrFolder = "" Then Exit Sub
strFnd = InputBox("What is the string to find?", "File Finder")
If Trim(strFnd) = "" Then Exit Sub
strNm = ActiveDocument.FullName
' Search the top-level folder
Call GetFolder(StrFolder & "\")
' Search the subfolders for more files
Call SearchSubFolders(StrFolder)
' Return control of status bar to Word
Application.StatusBar = ""
' Restore screen updating
Application.ScreenUpdating = True
MsgBox i & " files processed." & vbCr & "Matches with " & strFnd & " found in:" & strList, vbOKOnly
End Sub
Function GetTopFolder() As String
GetTopFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetTopFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function
Sub SearchSubFolders(strStartPath As String)
If FSO Is Nothing Then Set FSO = CreateObject("scripting.filesystemobject")
Set oFolder = FSO.GetFolder(strStartPath)
Set oSubFolder = oFolder.subfolders
For Each oFolder In oSubFolder
Set oFiles = oFolder.Files
' Search the current folder
Call GetFolder(oFolder.Path & "\")
' Call ourself to see if there are subfolders below
SearchSubFolders oFolder.Path
Next
End Sub
Sub GetFolder(StrFolder As String)
strFile = Dir(StrFolder & "*.doc", vbNormal)
' Process the files in the folder
While strFile <> ""
' Update the status bar is just to let us know where we are
Application.StatusBar = StrFolder & strFile
i = i + 1
Call DocTest(StrFolder & strFile)
strFile = Dir()
Wend
End Sub
Sub DocTest(strDoc As String)
Dim Doc As Document
' Open the document
If strDoc <> strNm Then
Set Doc = Documents.Open(strDoc, AddToRecentFiles:=False, ReadOnly:=True, Format:=wdOpenFormatAuto, Visible:=False)
With Doc
With .Range
With .Find
.Text = strFnd
.MatchCase = False
.MatchAllWordForms = False
.MatchWholeWord = False
.Execute
If .Found Then strList = strList & vbCr & strFile
End With
End With
.Close SaveChanges:=False
End With
End If
' Let Word do its housekeeping
DoEvents
Set Doc = Nothing
End Sub
I just want to shortern the code as i've the following
folder or a directory
"C:\Sam-Documents\VBA-Word" Basically to search *.docx files in the mentioned directory folder.
as i don't want to have option to choose a folder and its sub folder
Will be really grateful to you
SamD