VBA Error: Object variable or With block variable not set - while looping through directory

MHamid

Active Member
Joined
Jan 31, 2013
Messages
472
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Hello,

Hopefully I will not confuse anyone.
I am getting an error for my code below. I copied the entire code in case anyone also has ideas to optimize it as well.

The purpose of the code is to:
  1. Look though all PDF files in specified directory
  2. When it finds the first PDF file
    1. Open the PDF File in WORD
    2. Copy data from WORD
    3. Paste Data from WORD into Excel as "Text"
    4. Close WORD without saving (Don't need to save file)
    5. Run two macros that will extract the data I need from the PDF file into another sheet within the same workbook
    6. Clear the Contents from Sheet (sheet where PDF data was copied into as text as it is no longer needed)
  3. Repeat steps 1-6 (from step 2) for the next PDF file

The code works great for the first PDF file it finds, but it gives me an "Run-time error '91': Object variable or With block variable not set" when it starts to loop for the next PDF File. What did I miss in the code for the loop to work correctly?

The error appears in this part of the code:
Code:
        Set oDoc = wordApp.Documents.Open(fileName:=strPath & strFile, _
            ConfirmConversions:=False)

And this is the full code:
Code:
Sub pdf_To_Excel_Word()'Macro opens PDF Files as an editable Word Document
'Copies the contents of the Word document
'Pastes the Clipboard contents into Excel


'Declare Variables
    Dim myWorksheet As Worksheet
    Dim wordApp As Object
    Dim myWshShell As wshShell
    Dim strPath
    Dim oDoc As Object
    Dim strFile As String
    Dim registryKey As String
    Dim wordVersion As String
    


'Set Variables
    'Error
        On Error Resume Next
            Set wordApp = GetObject(, "Word.Application")
                If Err Then
                    Set wordApp = CreateObject("Word.Application")
                End If
        On Error GoTo 0
    
    Set myWshShell = New wshShell
    strPath = "C:\Users\mh15601\Desktop\Projects\Audit Plan\2019\Testing\PDF Files\DO NOT DELETE\"
    wordVersion = wordApp.Version
    registryKey = "HKCU\SOFTWARE\Microsoft\Office\" & wordVersion & "\Word\Options\"


'Optimize Macro
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual


'Open and Copy PDF Files
    myWshShell.RegWrite registryKey & "DisableConvertPdfWarning", 1, "REG_DWORD"
    
    strFile = Dir$(strPath & "*.pdf")
    While strFile <> ""
        
        Set oDoc = wordApp.Documents.Open(fileName:=strPath & strFile, _
            ConfirmConversions:=False)
        
        'Copy Data from Word
            oDoc.Content.Copy
            
        'Excel
            Set myWorksheet = ActiveWorkbook.Worksheets("Test")
            With myWorksheet
                .Range("A1").Select
                .PasteSpecial Format:="Text"
            End With
            
        'Close Word
            oDoc.Close SaveChanges:=0
        myWshShell.RegWrite registryKey & "DisableConvertPdfWarning", 0, "REG_DWORD"
    
        'Clear Word and PDF
            Set wordApp = Nothing
            Set myWshShell = Nothing
            
        'Run Excel Macros
            With myWorksheet
                Run ExtractingData
                Run ProcessedAudits
            End With
            
        'Clear Test Sheet
                Sheets("Test").Cells.ClearContents
        strFile = Dir$()
    Wend
    
'Message Box when Complete
    MsgBox "Complete!"
    
'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
End Sub


Function ExtractingData()
' ExtractingData Macro
' Purpose: Extract PDF Audit Files data from Excel to be processed into SharePoint
    
'Define Variable
Dim lRow As Long


'Set Variable
lRow = Range("A" & Rows.Count).End(xlUp).Row
           
Worksheets("Test").Activate
           
    With Worksheets("Test")
     'Find "Report Issuance Date" Data and Paste into ChartData tab
        Cells.Find(What:="Report Issuance Date", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
        Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(1, 0)).Select
        Selection.Copy Destination:=Sheets("Other").Range("A2")
    
     'Find "Audit Reference Number" Data and Paste into ChartData tab
        Sheets("Test").Select
        Cells.Find(What:="Audit Reference Number", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
        Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(2, 0)).Select
        Selection.Copy Destination:=Sheets("Other").Range("A3")
        
    'Find "Rating" Data and Paste into ChartData tab
        Sheets("Test").Select
        Cells.Find(What:="Rating", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
        Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(1, 0)).Select
        Selection.Copy Destination:=Sheets("Other").Range("A5")
    
    'Find "Executive(s)" Data and Paste into ChartData tab
        Sheets("Test").Select
        Cells.Find(What:="Executive(s)", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
        ActiveCell.Select
        Selection.Copy Destination:=Sheets("Other").Range("A7")
    
    'Find "Key Measures" Data and Paste into ChartData tab
        Sheets("Test").Select
        Cells.Find(What:="Key Measures", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
            :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
            False, SearchFormat:=False).Activate
        Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(9, 4)).Select
        Selection.Copy Destination:=Sheets("Other").Range("A9")
        
    'Formula for above data
        Sheets("Other").Select
        Range("E2").FormulaR1C1 = "=R2C1"
        Range("E3").FormulaR1C1 = "=MID(R3C1,FIND(""Audit ID"",R3C1)+9,99)"
        Range("E4").FormulaR1C1 = "=MID(R4C1,FIND(""Report ID"",R4C1)+10,99)"
        Range("E5").FormulaR1C1 = "=MID(R5C1,FIND(""Audit Rating:"",R5C1)+14,99)"
        Range("E6").FormulaR1C1 = "=TRIM(R6C1)"
        Range("E7").FormulaR1C1 = "=MID(R7C1,SEARCH(""Accountable"",R7C1)+12,SEARCH(""Executive"",R7C1)-SEARCH(""Accountable"",R7C1)-13)"
        
        Range("E:E").Copy
        Range("E:E").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        
    'Find "Issue#" Data and Paste into ChartData tab
        Sheets("Test").Select
        Cells.Find(What:="Issue #", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
        Range(Selection, Selection.End(xlToRight).End(xlDown)).Select
        Selection.Copy Destination:=Sheets("ChartData").Range("A1")
        
    'Find "IBAM" Data and Paste into ChartData tab
        Sheets("Test").Select
     
        Cells.Find(What:="Issue Relevance", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
                :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                False, SearchFormat:=False).Activate
        Cells.Find(What:="IBAM", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
                :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                False, SearchFormat:=False).Activate
        Range(ActiveCell.Offset(2, 0), ActiveCell.Offset(2, 1)).Select
        Selection.Copy Destination:=Sheets("ChartData").Range("H1")
        
    'Delete non-numeric rows in Column A
        Sheets("ChartData").Select
        With Range("A2", Cells(Rows.Count, 1).End(xlUp))
             .SpecialCells(xlCellTypeConstants, xlTextValues).EntireRow.Delete
        End With
        
    'Convert Text to Column IBAM Data
        Application.DisplayAlerts = False
        Range("I1").TextToColumns Destination:=Range("J1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
            Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
            :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
        Application.DisplayAlerts = True
    End With
    
    'IBAM Formula
        Range("D2:D" & lRow).Formula = "=IFNA(IF(RC[-3]=HLOOKUP(RC[-3],R1C9:R1C32,1,0),""IBAM"",""""),"""")"
        Range("E2:E" & lRow).Formula = "=RC[-2]&"" ""&RC[-1]"
        
        Range("D2:E" & lRow).Copy
        Range("D2:E" & lRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        
        Range("A1").Select


End Function


Function ProcessedAudits()
'Macro to extract audit data from Tests into Excel


'Define Variables
    Dim LR As Long
    Dim LastR As Long
    
'Set Variables
    LR = Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    LastR = Range("A" & Rows.Count).End(xlUp).Row


Worksheets("Audit Data").Activate


'Add Audit Data
    With Worksheets("Audit Data")
        Range("A" & LR).Formula = "=Other!R3C5"
        Range("B" & LR).Formula = "=Other!R7C5"
        Range("C" & LR).Formula = "=Other!R2C5"
        Range("D" & LR).Formula = "=Other!R5C5"
        Range("E" & LR).Formula = "=Other!R4C5"
        Range("F" & LR).Formula = "=Test!R3C1"
        Range("G" & LR).Formula = "=COUNTIF(ChartData!C[-4],""Level 1"")"
        Range("H" & LR).Formula = "=COUNTIF(ChartData!C[-5],""Level 2"")"
        Range("I" & LR).Formula = "=COUNTIF(ChartData!C[-6],""Level 3"")"
        Range("J" & LR).Formula = "=COUNTIF(ChartData!C[-7],""Level 4"")"
        Range("K" & LR).Formula = "=COUNTIF(ChartData!C[-8],""Level 5"")"
        Range("L" & LR).Formula = "=SUM(RC[-5]:RC[-1])"
        Range("M" & LR).Formula = "=COUNTIF(ChartData!C[-8],""Level 1 IBAM"")"
        Range("N" & LR).Formula = "=COUNTIF(ChartData!C[-9],""Level 2 IBAM"")"
        Range("O" & LR).Formula = "=COUNTIF(ChartData!C[-10],""Level 3 IBAM"")"
        Range("P" & LR).Formula = "=COUNTIF(ChartData!C[-11],""Level 4 IBAM"")"
        Range("Q" & LR).Formula = "=COUNTIF(ChartData!C[-12],""Level 5 IBAM"")"
        Range("R" & LR).Formula = "=SUM(RC[-5]:RC[-1])"
        Range("S" & LR).Formula = "=TRIM(LEFT(SUBSTITUTE('Other'!R16C3,""%"",REPT("" "",100)),100))"
        Range("T" & LR).Formula = "=TRIM(LEFT(SUBSTITUTE('Other'!R16C4,""%"",REPT("" "",100)),100))"
        Range("U" & LR).Formula = "=TRIM(LEFT(SUBSTITUTE('Other'!R17C4,""%"",REPT("" "",100)),100))"
        Range("V" & LR).Formula = "=TRIM(LEFT(SUBSTITUTE('Other'!R18C4,""%"",REPT("" "",100)),100))"
        
        'Copy PasteSpecial Values
        Range("A2:V" & LastR).Copy
        Range("A2:V" & LastR).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        
        Range("A1").Select
    
    End With


End Function

Thank you
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
During the loop, you set wordApp to Nothing. The second loop there is no wordApp to have a .Documents property.
 
Upvote 0
Awesome!! That stopped the error message.

Now I am getting a message stating "Microsoft Excel is waiting for another application to complete an OLE action." Every time I click on OK, it keeps popping up.
I minimized some applications and saw that along with that pop message I also see another popup message from Word stating "Word will now convert your PDF to an editable Word document. This may take a while. The resulting Word document will be optimized to allow you to edit the text, so it might not look exactly like the original PDF especially if the original file contained lots of graphics. " with an option to select a box stating "Don't show this message again". I select that box and click OK. The first popup message appear a couple times before I get a VBA "Run-time error '1004': Select method of Range class failed". This error appears in the part of the code where it pastes the Word data into Excel (red text section).

1. How can I ignore the Word message from appearing when it loops to the next PDF File?
2. Why am I getting the VBA error message when it loops to the second PDF File and not the first?
Code:
            Set myWorksheet = ActiveWorkbook.Worksheets("PDF FILE")            With myWorksheet
[COLOR=#ff0000]                .Range("A1").Select[/COLOR]
                .PasteSpecial Format:="HTML"
            End With

Thank you
 
Upvote 0
I am not the person to talk to about cross program coding. BUT, rather than copy/select/paste it would probably be better to put the text from Word into a variable and write that variable to Excel.
 
Upvote 0

Forum statistics

Threads
1,223,943
Messages
6,175,547
Members
452,652
Latest member
eduedu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top