|
|
Thread Tools | Display Modes |
#16
|
|||
|
|||
Still getting error. Here is the code and i can only hope that after fixing this error (if I manage to), all the folders, including the ones from internal network will be visible on relevant location:
Code:
Sub Search() ' ' Search Macro '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 = Trim(InputBox("What is the Top Folder, "Get Top Folder")) 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 End Sub |
#17
|
||||
|
||||
Your modified 'StrFolder =' line is not the same as in post #10...
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#18
|
|||
|
|||
After I already define the path where to search and after I already define text/string which one to search, the following message occurs:
"Run-time Error '424': Object required" If I click on button Debug then yellow background in on the following text of code ''If FSO Is Nothing Then'' and therefore the yellow arrow is on the left side of the following line: If FSO Is Nothing Then Set FSO = CreateObject("scripting.filesystemobject") |
#19
|
||||
|
||||
Quite frankly, you've made a complete mess of the code I posted!!!! Compare what's in post #16 against what's in posts #6 & #10. If you're going to mess with the code as you have done, don't come back complaining it doesn't work. The code I posted does work.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#20
|
|||
|
|||
I spent last 10 hours nonstop trying to solve this and no progress at all. This is exact copy paste of ENTIRE code I have and in the relevant line I showed in my previous post, I don't see any difference:
Code:
Sub Search() ' ' Search Macro '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 = Trim(InputBox("What is the Top Folder?", "Get Top Folder")) 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 |
#21
|
||||
|
||||
Why don't you compare the code I posted with the code you're using They ARE NOT even close to being the same. You have added lines that don't belong there and commented-out another that should not be commented-out. The problem is entirely of your own making.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#22
|
|||
|
|||
In this message I am attaching the latest copy paste version of the code I use. This one should be a little better but there is still problem which is mentioned on the sceeenshot in this message before the attached code. Note that when I click on button ''debug'' the line which gets yellow background colored is the following one without the quotes: ".Execute" and I would also like to add the following information: The error message shown on screenshot occurs after around 20 minutes of searching time. BEFORE error occurs, I don't see any problem at all - entire searching procedure seems OK. Very long searching time is no problem and understandable because the macro is ''working with'' over 20 000 doc/docx files at the same time.
SCREENSHOT: http://imgur.com/a/60Hu5 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 = Trim(InputBox("What is the Top Folder?", "Get Top Folder")) 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 |
#23
|
||||
|
||||
Evidently one or more of your documents employs some form of protection that prevents its content being searched. You have two choices:
1. Skip such files; or 2. Provide the access password for them. Either would require coding changes. The first option is the simpler to implement.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Run a macro on multiple docx. files | Peter Carter | Word VBA | 27 | 12-15-2022 04:10 PM |
Run Code on all files and save files as .docx | Plokimu77 | Word VBA | 4 | 06-05-2016 04:41 PM |
seach an Excel list elements in word document | 7ajar | Word VBA | 5 | 03-16-2011 12:38 PM |
Word 2010 not reading docx files | Dannyg | Word | 1 | 09-22-2010 09:45 PM |
Multiple editor at the same time with Word? | GaGaGa | Word | 1 | 09-19-2010 02:24 AM |