I have some code I combined from a couple sources that will open a bunch of pdf's in a directory using Word to extract a sentence of text and place it to excel. It works but is slow because it's opening and closing Word with each iteration. But when I try opening Word before the loop by moving Set WApp = CreateObject("Word.Application") before the start of the loop (and WPapp.Quit after it ends), I get a run time error saying the object is not set. Any advice on how to improve this appreciated.
Code
Option Explicit
Sub LoopPDFsInFolder()
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim r As Long
Dim WApp As Object
Dim WDoc As Object
Dim WDR As Object
Dim ExR As Range
' Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
myPath = "c:\temp\"
myExtension = "*.PDF*"
myFile = Dir(myPath & myExtension)
r = 0
On Error GoTo ResetSettings
Do While myFile <> "" 'Loop through each Excel file in folder
Set ExR = Selection ' current location in Excel Sheet
Set WApp = CreateObject("Word.Application")
'WApp.Visible = True
Set WDoc = WApp.Documents.Open(myPath & myFile)
WApp.Selection.HomeKey Unit:=6
WApp.Selection.Find.ClearFormatting
WApp.Selection.Find.Execute "In the matter of the" 'find key phrase
WApp.Selection.MoveDown Unit:=5, Count:=1
WApp.Selection.HomeKey
WApp.Selection.MoveRight Unit:=3, Count:=1, Extend:=1
Set WDR = WApp.Selection ' copy selected sentence to excel
ExR(1, 1).Offset(r, 0) = WDR ' place below selected cell
r = r + 1
WDoc.Close
WApp.Quit
myFile = Dir 'Get next file name
Loop
Set WApp = Nothing
Set WDoc = Nothing
Set WDR = Nothing
MsgBox "Done!"
ResetSettings:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Display More