Excel VBA Open pdf (struggling)

[dwilson38550m]

Hi,

I have created a macro code to create a .pdf file (Review and Review History tabs) but I would also like to create a code to open this file up. Unfortunately, I have had little success opening the pdf file up. Could anyone suggest anything, please? If possible I would like to open the .pdf file with the location noted on cell S1 of Sheet1.

Thanks in advance.

Sub convertpdf()
'
' convertpdf Macro
'

    Dim future As String
    Dim future5 As String
   

Sheets("Review").Activate
Sheets(Array("Review", "Review History")).Select

    ActiveWindow.ActivateNext

    Sheets("Data Sheet").Select
    Range("S1").Select
    future5 = ActiveCell
continue:      ActiveWindow.ActivateNext
    Application.DisplayAlerts = False
    Rem ActiveWorkbook.Close SaveChanges:=FALSE
   
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=future5
   
       
    Application.DisplayAlerts = True

    ActiveWorkbook.Close SaveChanges:=False
    Sheets("data sheet").Select
    Range("A1").Select

'
End Sub


Sub openpdf()
'
' openpdf Macro

'
    Dim strFilename As String

    strFilename = "P:\Co3\04\Contract Review - 427078.pdf"

    Call Shell(strFilename, vbNormalFocus)


'
End Sub

 

[John_w]

Add this to the module:

Public Sub Open_PDF(PDFfullName As String)
    CreateObject("Shell.Application").Namespace(Left(PDFfullName, InStrRev(PDFfullName, "\"))).Items.Item(Mid(PDFfullName, InStrRev(PDFfullName, "\") + 1)).InvokeVerb "Open"
End Sub

and call it like this:

    Open_PDF Worksheets("Data Sheet").Range("S1").Value

 

[dwilson38550m]

Add this to the module:

Public Sub Open_PDF(PDFfullName As String)
    CreateObject("Shell.Application").Namespace(Left(PDFfullName, InStrRev(PDFfullName, "\"))).Items.Item(Mid(PDFfullName, InStrRev(PDFfullName, "\") + 1)).InvokeVerb "Open"
End Sub

and call it like this:

    Open_PDF Worksheets("Data Sheet").Range("S1").Value

 

[dwilson38550m]

Perfect. Works Ok. Many thanks.

 

[dwilson38550m]

Sorry, is there a code I can add on at the end to print the active pdf sheet? Thanks

 

[John_w]

For something like this I usually record a macro whilst printing the active sheet and incorporate the generated code.

The macro recorder generates:

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

and the PrintOut method can also be applied to a sheet:

    ActiveSheet.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

 

[dwilson38550m]

That sorted the problem. Much appreciated - many thanks.

 

[dwilson38550m]

Hi,

Can I ask if there is a code I can use to close an active pdf workbook? Thanks

 

[dwilson38550m]

Hi John W,

I used the code below to try to print the active pdf file however instead this only prints the Excel file that holds the macro - can you think of anything else I can do to print the active pdf then close this down. The full code I am using is below. Sorry this is driving me a bit crazy but I feel I am close to resolving this. Thanks in advance.

-----------------------------------------------------------------------------------

Public Sub Open_PDF(PDFfullName As String)
CreateObject("Shell.Application").Namespace(Left(PDFfullName, InStrRev(PDFfullName, "\"))).Items.Item(Mid(PDFfullName, InStrRev(PDFfullName, "\") + 1)).InvokeVerb "Open"
End Sub
Sub openpdf()
'
' openpdf Macro

'

Open_PDF Worksheets("Data Sheet").Range("S1").Value



ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

'
End Sub
------------------------------------------------------------------------------------------------------------

 

[John_w]

The PrintOut method can only print the workbook or sheets. In the same way that InvokeVerb "Open" opens the PDF, InvokeVerb "Print" prints it. However, all methods to print the PDF leaves the PDF application (Acrobat/Adobe Reader) open, therefore we must close it using Windows API functions.

Put this code in a new module:

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function SetForegroundWindow Lib "user32.dll" (ByVal hWnd As LongPtr) As Long
    Private Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
#Else
    Private Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hWnd As Long) As Long
    Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
#End If


Public Sub Print_and_Close_PDF(PDFfullName As String)

    Print_PDF PDFfullName
    Find_and_Close_PDF_Window
    
End Sub


Private Sub Print_PDF(PDFfullName As String)
    CreateObject("Shell.Application").Namespace(Left(PDFfullName, InStrRev(PDFfullName, "\"))).Items.Item(Mid(PDFfullName, InStrRev(PDFfullName, "\") + 1)).InvokeVerb "Print"
End Sub


Private Sub Find_and_Close_PDF_Window(Optional PDFwindowTitle As String)

    #If VBA7 Then
        Dim hWnd As LongPtr
    #Else
        Dim hWnd As Long
    #End If
    Dim timeOutTime As Date
    
    Const WM_CLOSE As Long = &H10

    timeOutTime = DateAdd("s", 3, Now)
    Do
        DoEvents
        hWnd = FindWindow("AcrobatSDIWindow", PDFwindowTitle)
        Sleep 100
    Loop Until hWnd <> 0 Or Now > timeOutTime
    
    If hWnd <> 0 Then
        'Close the PDF window
        Sleep 1000
        SendMessage hWnd, WM_CLOSE, 0&, 0&
    Else
        AppActivate Application.Caption
        MsgBox "Could not find Acrobat window" & IIf(PDFwindowTitle <> "", " with title '" & PDFwindowTitle & "'", "")
    End If

End Sub

To print and close your PDF add this to your macro:

    Print_and_Close_PDF Worksheets("Data Sheet").Range("S1").Value