VBA code - Print a PDF document in corresponding Cell

[Ben171]

I have a database which stores entries from user.

in Cells D2:D100 are Works Order Numbers,
in Cells R2:R100 are hyperlinks to a PDF that is corresponding to that works order number.

I would like to write some code in which users enters a works order number in cell C3 of the "print documents sheet"

It will then search the "Database" sheet for that works order number, and then when it has found it, it prints the PDF which is in Cell R at the end of the row in which the works order number is in.

I have started writing some code to do this, I have written some code that loops through the rows and finds the work order number. However i am not sure how to do the inbetween bit, which is to print the pdf at the end of the row.

any help would be greatly appreciated, see starter code below

Dim iRow As Long 'Variable to hold the starting row and loop through all records in database
Dim sh As Worksheet 'worksheet variable to refer  to where database is stored
Dim myValue As Variant
Dim WorksOrder As String
Dim Found As Boolean



'Get user entered WorksOrder Number

WorksOrder = ThisWorkbook.Sheets("PrintDocuments").Range("C3").Value


'Set worksheet

Set sh = ThisWorkbook.Sheets("Database")

iRow = 2 'row in which data starts from in database

Found = False

Do While sh.Range("A" & iRow).Value <> ""  'loop through until no data is found (last row of database)
 
If WorksOrder = sh.Range("D" & iRow).Value Then

Found = True

'Insert print PDF code here











Exit Do

End If

iRow = iRow + 1

Loop



If Found = True Then
MsgBox ("Document Printed")
Else
MsgBox ("Works Order Number Not Found")
End If

End Sub

 

[Ben171]

]The macro leaves an empty Adobe/Acrobat window open - more code is needed to close it.

It also isn't even opening the PDF in any of these programs

 

[John_w]

this code runs, and i get the printed message. However it is not being sent to the printer. (I haven't specified one so i assume it would go to the default printer)?

Yes, as written it should go to the default printer. The code uses Windows Shell to print, however if 'Print' isn't one of the options when you right-click a PDF file (context menu) then nothing will print using that method.

Here is another method which uses the Adobe/Acrobat command line /t option to print the PDF.

Option Explicit
 
#If VBA7 Then
    Private Declare PtrSafe Function ShellExecute Lib "shell32" Alias "ShellExecuteA" (ByVal hWnd As LongPtr, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    Private Declare PtrSafe Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
#Else
    Private Declare Function ShellExecute Lib "shell32" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" (ByVal lpFile As String, ByVal lpDirectory As String, ByVal lpResult As String) As Long
#End If

Private Const SW_HIDE As Long = 0&
Private Const MAX_PATH = 260


Public Sub Print_Works_Order_PDF()

    Dim WorksOrder As String
    Dim foundRow As Variant
    Dim PDFfile As String, printStatus As String
    Dim printerName As String
   
    printerName = ""                    'use default printer
    'printerName = "The printer name"    'use specific printer

    WorksOrder = ThisWorkbook.Worksheets("PrintDocuments").Range("C3").Value
    With ThisWorkbook.Worksheets("Database")
        foundRow = Application.Match(WorksOrder, .Columns(4), 0)
        If IsError(foundRow) Then foundRow = Application.Match(CLng(WorksOrder), .Columns(4), 0)
        If Not IsError(foundRow) Then
            PDFfile = HyperlinkLocation(.Cells(foundRow, "R").Formula)
            printStatus = Shell_Print_PDF(PDFfile, printerName)
            If printStatus = "" Then
                MsgBox "Printed " & PDFfile & " for Works Order Number " & WorksOrder, vbInformation
            Else
                MsgBox "Not printed " & PDFfile & " for Works Order Number " & WorksOrder & vbCrLf & vbCrLf & _
                       printStatus, vbExclamation
            End If
        Else
            MsgBox "Works Order Number " & WorksOrder & " not found", vbExclamation
        End If
    End With
   
End Sub


Private Function Shell_Print_PDF(PDFfullName As String, Optional printerName As String) As String

    Static PDFexe As String
    Dim command As String
    Dim pid As Long
   
    'Prints the PDF file on the default or specified printer using the Acrobat or Adobe /t command line option
   
    'AcroRd32.exe /t path "printername" "drivername" "portname"
    'Initiates Acrobat or Adobe Reader and prints a file, whose path must be fully specified, while suppressing the Print dialog box.
    '
    'The four parameters of the /t option evaluate to path, printername, drivername, and portname (all strings).
    'printername — The name of your printer.
    'drivername  — Your printer driver’s name, as it appears in your printer’s properties.
    'portname    — The printer’s port. portname cannot contain any "/" characters; if it does, output is routed to
    '              the default port for that printer.
   
    Shell_Print_PDF = ""
   
    If Dir(PDFfullName) <> vbNullString Then
   
        If PDFexe = "" Then PDFexe = ExePath(PDFfullName)
        If PDFexe <> "" Then
            command = Q(PDFexe) & " /t " & Q(PDFfullName)
            If printerName <> "" Then command = command & " " & Q(printerName)
            pid = Shell(command, vbMinimizedNoFocus)
        Else
            Shell_Print_PDF = "Error: No file association"
        End If
       
    Else
   
        Shell_Print_PDF = "Error: file not found"
       
    End If
       
End Function


Private Function ExePath(lpFile As String) As String
    Dim lpDirectory As String, sExePath As String, rc As Long
    lpDirectory = "\"
    sExePath = Space(MAX_PATH)
    rc = FindExecutable(lpFile, lpDirectory, sExePath)
    ExePath = Left$(sExePath, InStr(sExePath, Chr$(0)) - 1)
End Function


Private Sub ShellExecute_Print(file As String, Optional printerName As String)
    If printerName = "" Then
        ShellExecute Application.hWnd, "PrintTo", file, vbNullString, 0&, SW_HIDE
    Else
        ShellExecute Application.hWnd, "PrintTo", file, Chr(34) & printerName & Chr(34), 0&, SW_HIDE
    End If
End Sub

Private Function HyperlinkLocation(HyperlinkFormula As String) As String

    'Parse a =HYPERLINK(CONCATENATE( formula and return what the link_location parameter evaluates to.  Should work with 1 or more CONCATENATE arguments
   
    Dim p1 As Long, p2 As Long
    Dim concatArgs As Variant, i As Long

    HyperlinkLocation = ""
    p1 = InStr(1, HyperlinkFormula, "=HYPERLINK(CONCATENATE(", vbTextCompare)
    If p1 > 0 Then
        p1 = p1 + Len("=HYPERLINK(CONCATENATE(")
        p2 = InStrRev(HyperlinkFormula, ")", -1)
        p2 = InStrRev(HyperlinkFormula, ")", p2 - 1)
        concatArgs = Split(Mid(HyperlinkFormula, p1, p2 - p1), ",")
        For i = 0 To UBound(concatArgs)
            HyperlinkLocation = HyperlinkLocation & Evaluate(concatArgs(i))
        Next
    End If
   
End Function

Private Function Q(text As String) As String
    Q = Chr(34) & text & Chr(34)
End Function

The macro can print on the default or a specific printer. For the latter, just delete the apostrophe at the start of this line and put your printer name between the quotes.

    'printerName = "The printer name"    'use specific printer

 

[John_w]

I've found a bug with the hyperlink formula parser. Should have a fix soon.

 

[Ben171]

I've found a bug with the hyperlink formula parser. Should have a fix soon.

Ah okay, thank you so much for your help btw.

is the following what you were talking about?

After changing to this code, it is failing to find the PDF. You can see it's searching for .pdf but not the "L2.pdf" (Batch number.pdf)

=HYPERLINK(CONCATENATE("T:\pe_projects\Engineering\Receiver Mounted Stationary Screw Compressors\9_RM Database\Safety Valve Certs\",L2,".pdf"),L2)

 

[John_w]

Yes, exactly that problem. Because the CONCATENATE L2 argument in this formula refers to a cell on the "Database" sheet, however the macro is being run from a different sheet (via a command button) and the parser thinks L2 refers to the active sheet, "PrintDocuments".

=HYPERLINK(CONCATENATE("T:\pe_projects\Engineering\Receiver Mounted Stationary Screw Compressors\9_RM Database\Safety Valve Certs\",L2,".pdf"),L2)

 

[Ben171]

Yes, exactly that problem. Because the CONCATENATE L2 argument in this formula refers to a cell on the "Database" sheet, however the macro is being run from a different sheet (via a command button) and the parser thinks L2 refers to the active sheet, "PrintDocuments".

Ah okay i see, that makes sense!

I have just confirmed this by placing the number in L2 of the "PrintDocuments" sheet, and the PDF did indeed open. (Didn't print though just opened).

So what now - shall i hang tight and wait for a bug fix?

 

[John_w]

Here is the bug fix. It's actually very tricky to parse cell formulas with VBA - there is nothing built in to extract the different parts of a formula or get the results of formula arguments. The only thing VBA can see is the cell value and the actual formula string.

New hyperlink parser:

Private Function HyperlinkLocation(HyperlinkCell As Range) As String

    'Parse a cell containing a =HYPERLINK(CONCATENATE( formula and return what the link_location parameter evaluates to.  Should work with 1 or more CONCATENATE arguments
    
    Dim p1 As Long, p2 As Long
    Dim concatArgs As Variant, i As Long

    Debug.Print HyperlinkCell.Formula
    HyperlinkLocation = ""
    p1 = InStr(1, HyperlinkCell.Formula, "=HYPERLINK(CONCATENATE(", vbTextCompare)
    If p1 > 0 Then
        p1 = p1 + Len("=HYPERLINK(CONCATENATE(")
        p2 = InStrRev(HyperlinkCell.Formula, ")", -1)
        p2 = InStrRev(HyperlinkCell.Formula, ")", p2 - 1)
        'Put CONCATENATE arguments in array
        concatArgs = Split(Mid(HyperlinkCell.Formula, p1, p2 - p1), ",")
        On Error Resume Next
        'Build function return value from the arguments
        For i = 0 To UBound(concatArgs)
            Debug.Print concatArgs(i)
            Err.Clear
            'Is this argument a cell reference, e.g. L2?
            If TypeName(Range(concatArgs(i))) = "Range" Then
                If Err.Number = 0 Then
                    'Yes - evaluate the cell and its worksheet name together
                    HyperlinkLocation = HyperlinkLocation & Evaluate("'" & HyperlinkCell.Worksheet.Name & "'!" & concatArgs(i))
                Else
                    'No
                    HyperlinkLocation = HyperlinkLocation & Evaluate(concatArgs(i))
                End If
            End If
            Debug.Print HyperlinkLocation
        Next
        On Error GoTo 0
    End If
    
End Function

Change the call to it by replacing:

            PDFfile = HyperlinkLocation(.Cells(foundRow, "R").Formula)

with:

            PDFfile = HyperlinkLocation(.Cells(foundRow, "R"))

 

[Ben171]

Here is the bug fix. It's actually very tricky to parse cell formulas with VBA - there is nothing built in to extract the different parts of a formula or get the results of formula arguments. The only thing VBA can see is the cell value and the actual formula string.

New hyperlink parser:

Private Function HyperlinkLocation(HyperlinkCell As Range) As String

    'Parse a cell containing a =HYPERLINK(CONCATENATE( formula and return what the link_location parameter evaluates to.  Should work with 1 or more CONCATENATE arguments
   
    Dim p1 As Long, p2 As Long
    Dim concatArgs As Variant, i As Long

    Debug.Print HyperlinkCell.Formula
    HyperlinkLocation = ""
    p1 = InStr(1, HyperlinkCell.Formula, "=HYPERLINK(CONCATENATE(", vbTextCompare)
    If p1 > 0 Then
        p1 = p1 + Len("=HYPERLINK(CONCATENATE(")
        p2 = InStrRev(HyperlinkCell.Formula, ")", -1)
        p2 = InStrRev(HyperlinkCell.Formula, ")", p2 - 1)
        'Put CONCATENATE arguments in array
        concatArgs = Split(Mid(HyperlinkCell.Formula, p1, p2 - p1), ",")
        On Error Resume Next
        'Build function return value from the arguments
        For i = 0 To UBound(concatArgs)
            Debug.Print concatArgs(i)
            Err.Clear
            'Is this argument a cell reference, e.g. L2?
            If TypeName(Range(concatArgs(i))) = "Range" Then
                If Err.Number = 0 Then
                    'Yes - evaluate the cell and its worksheet name together
                    HyperlinkLocation = HyperlinkLocation & Evaluate("'" & HyperlinkCell.Worksheet.Name & "'!" & concatArgs(i))
                Else
                    'No
                    HyperlinkLocation = HyperlinkLocation & Evaluate(concatArgs(i))
                End If
            End If
            Debug.Print HyperlinkLocation
        Next
        On Error GoTo 0
    End If
   
End Function

Change the call to it by replacing:

            PDFfile = HyperlinkLocation(.Cells(foundRow, "R").Formula)

with:

            PDFfile = HyperlinkLocation(.Cells(foundRow, "R"))

Wow ok i see what you've done there, very clever. I can definitely tell this must be a very advanced thing to do, would have had no chance without your help!

That now works a treat (as far as opening the correct PDF).

However i still cannot get it to print, I have left it as it is so that it uses the default printer however I am having no luck. I run the macro, it opens the PDF and that is all that happens.

Thanks

 

[John_w]

I see you're using Microsoft Edge as your PDF viewer (the .pdf file type default application). I can't find any way of printing a PDF from the command line with Edge, so I don't think the macro can print with Edge. Instead, the macro should work if you install Adobe Reader or Acrobat Pro. You can still keep Edge as the default PDF viewer, the code just needs Adobe Reader or Acrobat Pro.

Alternatively, there is the PDFtoPrinter command line utility:

PDFtoPrinter for Windows

The code would need some small changes to work with that.

 

[Ben171]

I see you're using Microsoft Edge as your PDF viewer (the .pdf file type default application). I can't find any way of printing a PDF from the command line with Edge, so I don't think the macro can print with Edge. Instead, the macro should work if you install Adobe Reader or Acrobat Pro. You can still keep Edge as the default PDF viewer, the code just needs Adobe Reader or Acrobat Pro.

Alternatively, there is the PDFtoPrinter command line utility:

PDFtoPrinter for Windows

The code would need some small changes to work with that.

Ah i see. I do have Adobe reader installed, setting that as my default application seemed to have fixed it, it's printing now!

Thank you so much for your help (and patience) over the last couple of days!