1

I used some code from Close an opened PDF after opening it using FollowHyperlink to create the following code to open a pdf file and rename it. The code runs fine but only if I break execution at MsgBox "Break Here" and step into it with the F8 key. Any ideas on why it won't execute automatically?

Sub OpenPDF()
    'Opens PDF Scaned file & saves it to another folder
    '***ErrorHandler***
    On Error Resume Next
    '***Declare Objects****
    Dim objectWMI As Object
    Dim objectProcess As Object
    Dim objectProcesses As Object
    Dim Path As String
    Dim MyDir As String
    '***Opens a new workbook if there are no active workbooks***
    '***There must be an active workbook for FollowHyperlink to function***
    nowbs = Application.Workbooks.Count
    If nowbs = 1 Then
        Application.Workbooks.Add
    Else
    End If
    '***Saves current Excel path
    MyDir = CurDir
    '***Sets path to Ricoh Scans
    PDFDir = "S:\Ricoh Scans"
    ChDir PDFDir
    '***Gets filename for PDF scan
    Path = Application.GetOpenFilename(filefilter:="PDF file (*.pdf), *.pdf")
    '***Opens PDF file***
    ActiveWorkbook.FollowHyperlink Path
    '***Sets Excel as active application
    AppActivate "Microsoft Excel"
    '***Prompts for PO number****
    MyPONum = InputBox("Enter PO Number", "PO Editor", "30500")
    '***If user selects Cancel on inputbox then xl closes Acrobat and exits sub
    If MyPONum = vbNullString Then
        GoTo EndAll
    Else
    End If
    '***Replaces scanned filename with inputbox filename
    PathLen = Len(Path)
    OldName = Mid(Path, 16, PathLen - 19)
    NewName = "S:\Materials Management\Purchase Orders\PO " & MyPONum & ".pdf"
EndAll:
    '***Set Objects***
    Set objectWMI = GetObject("winmgmts://.")
    Set objectProcesses = objectWMI.ExecQuery("SELECT * FROM Win32_Process  WHERE Name = 'Acrobat.exe'") '< Change if you need be ** Was AcroRd32.exe**
    '
    '
    'Code executes fine up to here but must Ctrl + Break at this line
    'and F8 step thru balance of code or it will not work
    '
    '
    MsgBox "Break Here"
    '***Terminate all Open PDFs***
    For Each objectProcess In objectProcesses
        Call objectProcess.Terminate
    Next
    '***Clean Up***
    Set objectProcesses = Nothing
    Set objectWMI = Nothing
    '***Renames scanned file and moves it to Materials Management folder***
    Name Path As NewName
    '***Resets current directory
    ChDir MyDir
End Sub
Brandon Barney
  • 2,382
  • 1
  • 9
  • 18
davidnt
  • 11
  • 1
  • 2
    Remove `On Error Resume Next` and you will likely get an informative error message. If that does not help you need to tell us how it fails. – Alex K. Jan 12 '18 at 18:44
  • 1
    `On Error Resume Next` is **NOT** an `***ErrorHandler***`. It **suppresses** errors an allows the code to keep executing in an error state, which means your code is making a *Very Bad Assumption™*. – Mathieu Guindon Jan 12 '18 at 18:53
  • 1
    If your code will not run straight through then that likely indicates a timing issue: some required process is not completing in time for the next step. – Tim Williams Jan 12 '18 at 19:19
  • 1
    To fix the issue you are having, you likely need some kind of delay between termination of processes. Try adding `Application.Wait(Now + TimeValue("00:00:02"))` before `Call objectProcess.Terminate` (and you should also remove `Call`. – Brandon Barney Jan 12 '18 at 19:20
  • Thanks to all for your input. I'm not a programmer and as I said I used code that had been posted elsewhere on this site.It was a timing issue. – davidnt Jan 15 '18 at 14:37

1 Answers1

0

Thanks to all for your input. I'm not a programmer and as I said I used code that had been posted elsewhere on this site. It was a timing issue and this edit works.

    '***Terminate all Open PDFs***
    For Each objectProcess In objectProcesses
    objectProcess.Terminate
    Next
    '***Clean Up***
    Set objectProcesses = Nothing
    Set objectWMI = Nothing
    '***************
    Application.Wait (Now + TimeValue("00:00:02"))
    '***Renames scanned file and moves it to Materials Management folder***
    Name Path As NewName
    '***Resets current directory
    ChDir MyDir

    End Sub
davidnt
  • 11
  • 1