Performing Find loop on all Word documents in a folder, writing results to a Spreadsh

[fraanchtoast]

Hi all,
VBA rookie here. I am trying to write an Excel macro that opens a number of Word documents one-by-one, performs a find loop, and writes the found text to the spreadsheet. My code is throwing a type mismatch error on the line

Set oDoc = Documents.Open(MyFile, Visible:=False)

Any help would be appreciated!!

 
Sub DetailFinder()
 
 Dim fd As FileDialog
 Dim PathOfSelectedFolder As String
 Dim SelectedFolder
 Dim SelectedFolderTemp
 Dim MyPath As FileDialog
 Dim fs
 Dim ExtraSlash
 ExtraSlash = "\"
 Dim MyFile As Object
 Dim wRng As Word.Range
 Dim oWord As Word.Application
 Dim WordWasNotRunning As Boolean
 Dim oDoc As Word.Document
'Prepare to open a modal window, where a folder is selected
Set MyPath = Application.FileDialog(msoFileDialogFolderPicker)
With MyPath
'Open modal window
        .AllowMultiSelect = False
       If .Show Then
           'The user has selected a folder
             'Loop through the chosen folder
            For Each SelectedFolder In .SelectedItems
                'Name of the selected folder
                 PathOfSelectedFolder = SelectedFolder & ExtraSlash
                Set fs = CreateObject("Scripting.FileSystemObject")
                Set SelectedFolderTemp = fs.GetFolder(PathOfSelectedFolder)
                    'Loop through the files in the selected folder
                     For Each MyFile In SelectedFolderTemp.Files
                        'Open each file:
 
                        Set oDoc = Documents.Open(MyFile, Visible:=False)
                        Set wRng = oDoc.Range
 
                        i = 1
                        Do
                            'Word Macro
 
 
                            With wRng.Find
                                .Text = "Stg-?*psi/ft."
                                .Forward = True
                                .Wrap = wdFindStop
                                .MatchWildcards = True
                                .Execute
                            End With
                            If wRng.Find.Found Then
                                 'Increment the row
                                'xRow = xRow + 1
                                 'Add the Find to the worksheet
                                WS.Cells(1, i) = wRng
                                'Call ClearFindAndReplaceParameters
                                i = i + 1
                            End If
 
                        Loop While wRng.Find.Found
 
                        MyFile.Close savechanges:=wdDoNotSaveChange
 
 
                    Next
            Next
        End If
End With
 
End Sub

[snb]

if those wordfiles reside in the same folder you can use:

[vba]
sub snb()
c00="G:\OF\"
c01=dir(c00 & "*.doc*")

do until c01=""
with getobject(c00 & c01)
--- - - -- - - - - -
.close 0
end with
c01=dir
loop
End Sub
[/vba]

[Kenneth Hobs]

Welcome to the forum!

That is not such an easy task for one new to VBA. Since you are working in Excel VBA, your code failed because Documents is an MSWord method. You need to prefix with the MSWord application object.

See if these help:
'FindReplace Text
' http://www.excelforum.com/excel-prog...-ms-excel.html
' http://www.vbaexpress.com/forum/showthread.php?t=38958
' http://www.vbaexpress.com/forum/showthread.php?p=250215
' http://www.vbaexpress.com/forum/showthread.php?t=42833
' http://support.microsoft.com/kb/240157
' http://word.tips.net/T001833_Generat...currences.html

[fraanchtoast]

Hi Kenneth, thanks for the links.

When i prefix the code with an MSWord application object:

[VBA]
Set oDoc = oWord.Documents.Open(MyFile, Visible:=False)
[/VBA]

I get a run-time error '91': Object Variable or With Block variable not set.

Any advice?

Thanks for your help!

[snb]

If you use 'Getobject' (see my previous post) you won't need that.

[Kenneth Hobs]

Either the word object exists or it does not. From the 250215 thread note how it is set by either GetObject or CreateObject:
[vba] Sub Test_SearchReplaceInDoc()
SearchReplaceInDoc "x:\MSWord\SearchReplace\SearchReplaceInDoc.doc", "XXXXX", "123", True, False
End Sub

'http://www.vbaexpress.com/forum/showthread.php?t=38958
Sub SearchReplaceInDoc(doc As String, findString As String, replaceString As String, _
Optional docVisible As Boolean = True, _
Optional closeDoc As Boolean = True)

Dim wdApp As Object, WD As Object, rn As Long

rn = ActiveCell.Row
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then Set wdApp = CreateObject("Word.Application")
On Error Goto 0

If Dir(doc) = "" Then Exit Sub
Set WD = wdApp.Documents.Open(doc)
wdApp.Visible = docVisible

With WD.Content.Find
.Text = findString '"XXXXX"
.Replacement.Text = replaceString '"123"
.Forward = True
.Wrap = 1
.Execute Replace:=2
End With

If closeDoc Then
Set WD = Nothing
Set wdApp = Nothing
End If
End Sub [/vba]