VBA - Can open PDF's, but how to print?

Ben171

Board Regular
Joined
Jul 2, 2021
Messages
88
Hi i have been working on this for a week or so and I am nearly there.

I got PDF's that are linked to a works order number. I would like the user to be able to enter the works order number and it will print the desired PDF.

I have gotten so far, in the fact that you can enter the works order number and find the right PDF, however I have only figured out how to open this file and not yet print.

As you can see from the below code, the user enters the works order number in cell C3 of a "PrintDocuments" sheet. It then goes to the sheet called "Database" and finds this works order number in column D. It then finds the corresponding PDF which is located in column S and opens it.

VBA Code:
Function OpenAnyFile(strPath As String)
  Set objShell = CreateObject("Shell.Application")
  objShell.Open (strPath)
End Function

Sub PrintReceiverCert()

Dim pdfPath As String
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
    With Sheets("Database")
        myMatch = Application.Match(WorksOrder, .Columns(4), 0)
        If IsNumeric(myMatch) Then
            pdfPath = "C:\Test\" & .Cells(myMatch, 19)
            Call OpenAnyFile(pdfPath)
        End If
    End With
Found = True


Exit Do

End If

iRow = iRow + 1

Loop

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

End Sub

Whilst this works great for opening, i would love to be able to send this pdf to the default printer. Any help would be amazing.

Thanks
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Thank you.

Integrating this code with my own has allowed me to get this working. Not sure if i've implemented it 100% correctly, but it's working.

For anyone interested, see code below

VBA Code:
Public Declare Function ShellExecute Lib "shell32.dll" 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

Public Function PrintPDF(xlHwnd As Long, FileName As String) As Boolean
Dim X As Long

On Error Resume Next
X = ShellExecute(xlHwnd, "Print", FileName, 0&, 0&, 3)

If Err.Number > 0 Then
    MsgBox Err.Number & ": " & Err.Description
    PrintPDF = False
Else
    PrintPDF = True
End If
On Error GoTo 0
End Function
 

Sub TESTPrintSpecificPDF()

Dim strPath As String
Dim WorksOrder As String

'Get user entered WorksOrder Number

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


If Len(WorksOrder) > 0 Then
    With Sheets("Database")
        myMatch = Application.Match(WorksOrder, .Columns(4), 0)
        If IsNumeric(myMatch) Then
            strPath = "C:\Test\" & .Cells(myMatch, 19)
        Else
        MsgBox "Works Order Number not found"
        End If
    End With
End If

If Not PrintPDF(0, strPath) Then
    MsgBox "Printing failed"
End If

End Sub
 
Upvote 0

Forum statistics

Threads
1,224,829
Messages
6,181,218
Members
453,024
Latest member
Wingit77

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