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:
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:
And this is the full code:
Thank you
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:
- Look though all PDF files in specified directory
- When it finds the first PDF file
- Open the PDF File in WORD
- Copy data from WORD
- Paste Data from WORD into Excel as "Text"
- Close WORD without saving (Don't need to save file)
- Run two macros that will extract the data I need from the PDF file into another sheet within the same workbook
- Clear the Contents from Sheet (sheet where PDF data was copied into as text as it is no longer needed)
- 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