PDA

View Full Version : Performing Find loop on all Word documents in a folder, writing results to a Spreadsh



fraanchtoast
09-06-2012, 02:01 PM
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
09-06-2012, 02:16 PM
if those wordfiles reside in the same folder you can use:


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

Kenneth Hobs
09-06-2012, 02:17 PM
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-programming/682014-replace-word-in-ms-word-with-varable-from-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_Generating_a_Count_of_Word_Occurrences.html

fraanchtoast
09-06-2012, 03:10 PM
Hi Kenneth, thanks for the links.

When i prefix the code with an MSWord application object:


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


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

Any advice?

Thanks for your help!

snb
09-07-2012, 01:37 AM
If you use 'Getobject' (see my previous post) you won't need that.

Kenneth Hobs
09-07-2012, 05:13 AM
Either the word object exists or it does not. From the 250215 thread note how it is set by either GetObject or CreateObject:
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