|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Would like to shortern the coding for searching docx file names in specific directory
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 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 |
#2
|
||||
|
||||
For example:
Code:
Sub GetDocumentStats() Application.ScreenUpdating = False Dim strFolder As String, strFile As String, strDocNm As String Dim strList As String, i As Long, wdDoc As Document strDocNm = ActiveDocument.FullName: strFolder = "C:\Sam-Documents\VBA-Word" strFile = Dir(strFolder & "\*.docx", vbNormal) While strFile <> "" If strFolder & "\" & strFile <> strDocNm Then i = i + 1 Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False) With wdDoc With .Range.Find .Text = strFnd .MatchCase = False .MatchAllWordForms = False .MatchWholeWord = False .Execute If .Found = True Then strList = strList & vbCr & strFile End With .Close SaveChanges:=False End With End If ' Let Word do its housekeeping DoEvents strFile = Dir() Wend Set wdDoc = Nothing MsgBox i & " files processed." & vbCr & "Matches with " & strFnd & " found in:" & strList, vbOKOnly Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#3
|
|||
|
|||
Macropod
Indeed that was the perfect shot to work in Word Macro file. Thank you so much. I tried the same to operate from MS-Excel VBA. But some how Files did not appear on the Rows. Below is the Code executed from Excel to display the files on the worksheet rows You may check the syntax at the end of the code which is in bold 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 Dim wks As Worksheet Set wks = Worksheets("sheet1") Dim rowindex As Long rowindex = 3 wks.Range("B1").Value = i & " Files Processed." wks.Range("C1").Value = "Matches with " & strFnd wks.Range("B2").Value = "Found in" On Error Resume Next Set wdApp = GetObject("word.Application") If Err Then Set wdApp = CreateObject("word.Application") End If Set wdDoc = wdApp.Documents.Add Application.ScreenUpdating = False Dim strFolder As String strFolder = "" strDocNm = wdApp.ActiveDocument.FullName strFolder = "C:\Characters-Folder\Word-Files\" strFile = Dir(strFolder & "\*.docx", vbNormal) strFnd = txtFindText.Text While strFile <> "" If strFolder & "\" & strFile <> strDocNm Then i = i + 1 Set wdDoc = wdApp.Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False) With wdDoc With .Range.Find .Text = strFnd .MatchCase = False .MatchAllWordForms = False .MatchWholeWord = False .Execute If .Found = True Then strList = strList & vbCr & strFile End With .Close SaveChanges:=False End With End If ' Let Word do its housekeeping DoEvents strFile = Dir() 'wks.Cells(rowindex, 2).Formula = strList 'rowindex = rowindex + 1 Wend Set wdDoc = Nothing ''''''MsgBox i & " files processed." & vbCr & "Matches with " & strFnd & " found in:" & strList, vbOKOnly 'wks.Range("B3").Value = strFile & vbCr 'strList & vbCr Application.ScreenUpdating = True End Sub |
#4
|
||||
|
||||
See, for example:
https://www.msofficeforums.com/word-...cel-sheet.html or, to run the process from Word: https://www.msofficeforums.com/word-...perscript.html
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#5
|
|||
|
|||
Thank you Macropod for posting the Links
Idea of Split function did the job SamD |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Searching WORD files for specific link ??? | ksor | Word VBA | 1 | 10-12-2019 08:33 PM |
Formula for searching names in one go | SilverChat | Excel | 2 | 05-07-2018 06:11 PM |
Using Word VBA to change file names in a directory | sg11 | Word VBA | 4 | 03-22-2018 04:25 AM |
Macro to check the existence of a word docx file and create a new word file with specific content. | staicumihai | Word VBA | 14 | 11-15-2016 01:42 AM |
How To Apply A VBA Macro to All Subfolders in a Directory of a docx. Extension | jc491 | Word VBA | 8 | 09-11-2015 08:31 AM |