How to print out PDF file from hyperlinks from an Excel spreadsheet

[RastaBomboclat]

Hi all,

I have an Excel file with VBA code that allows me, on a click of a button, to choose a folder and display on the active sheet, all the files in it (including those in sub-folders). Said files are listed on column B of the sheet in hyperlink, so that by clicking on a hyperlink, the related file open (display). They are almost all PDF files.

My need is to have a button which, when clicked, will print all the PDFs of these hyperlinks. My problem is here: printing those files. If there are 100 lines, printing them one by one would be really tiring and time consuming. I will lose efficiency and productivity.

Can you help me by finding / scripting a VBA code that can do that? This same code could help, I think, many other Internet users in the same situation.

Here is the code I use to display the hyperlinks pdf on the Excel spreadsheet:

Option Explicit

Dim dossier_origine As String
Dim ligne_ecrire As Long

With Application.FileDialog(msoFileDialogFolderPicker)

    .Title = "Select the folder to be scan"
    .Show

    If .SelectedItems.Count > 0 Then

        dossier_origine = .SelectedItems(1)

    Else

        Exit Sub

    End If

End With

Sheets("resultat_scan").Cells.Clear

Call lister_fichiers(dossier_origine, ActiveSheet.Name)

Application.ScreenUpdating = True

MsgBox "Scan well done", vbInformation, _
        "RastaBomboclat"

End Sub
Sub lister_fichiers(dossier_cours As String, feuille_destination As String)

Dim FSO As Scripting.FileSystemObject
Dim objet_dossier As Scripting.Folder
Dim objet_sous_dossier As Scripting.Folder
Dim objet_fichier As Scripting.File
Dim ligne_ecrire As Long
Dim nom_fichier_cours As String
Dim nom_dossier_sans_espaces As String
Dim nom_fichier_sans_espaces As String
Dim ligne_resultats As Long

'
Application.ScreenUpdating = False
'
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objet_dossier = FSO.GetFolder(dossier_cours)
'
ligne_ecrire = Sheets(feuille_destination).Range("A1048576").End(xlUp).Row + 1
'
nom_dossier_sans_espaces = Replace(objet_dossier.Path, " ", "%20")
'
'
Sheets(feuille_destination).Range("A" & ligne_ecrire).Hyperlinks.Add Anchor:=Sheets(feuille_destination).Range("A" & ligne_ecrire), Address:=nom_dossier_sans_espaces, TextToDisplay:=objet_dossier.Name
Sheets(feuille_destination).Range("A" & ligne_ecrire).Font.Bold = True
'
Sheets(feuille_destination).Range("B" & ligne_ecrire) = NombreFichiers(objet_dossier)
'
Sheets(feuille_destination).Range("C" & ligne_ecrire) = Sheets(feuille_destination).Range("B" & ligne_ecrire).Value * 4
'
'Sheets(feuille_destination).Range("D" & ligne_ecrire) = objet_dossier.ParentFolder.Name
Sheets(feuille_destination).Range("D" & ligne_ecrire) = objet_dossier.ParentFolder.Name & " => " & objet_dossier.Name

ligne_ecrire = ligne_ecrire + 1

'Loop on all files in the folder
For Each objet_fichier In objet_dossier.Files

    nom_fichier_cours = objet_fichier.Name

    nom_fichier_sans_espaces = Replace(objet_fichier.Name, " ", "%20")

    Sheets(feuille_destination).Range("A" & ligne_ecrire) = objet_dossier.Name
    Sheets(feuille_destination).Range("B" & ligne_ecrire).Hyperlinks.Add Anchor:=Sheets(feuille_destination).Range("B" & ligne_ecrire), Address:=nom_dossier_sans_espaces & "\" & nom_fichier_sans_espaces, TextToDisplay:=objet_fichier.Name
    Sheets(feuille_destination).Range("C" & ligne_ecrire) = objet_fichier.Type

    ligne_ecrire = ligne_ecrire + 1

    Sheets(feuille_destination).Range("A" & ligne_ecrire).Value = "Column-A"
    Sheets(feuille_destination).Range("A" & ligne_ecrire).Font.Bold = True
    '
    Sheets(feuille_destination).Range("B" & ligne_ecrire).Value = "Column-B"
    Sheets(feuille_destination).Range("B" & ligne_ecrire).Font.Bold = True
    '
    Sheets(feuille_destination).Range("C" & ligne_ecrire).Value = "Column-C"
    Sheets(feuille_destination).Range("C" & ligne_ecrire).Font.Bold = True
    '

Next objet_fichier

'--- Callback to subfolder ---
For Each objet_sous_dossier In objet_dossier.SubFolders

    Call lister_fichiers(objet_sous_dossier.Path, feuille_destination)

Next objet_sous_dossier

Range("D5:D10000").Select
With Selection
    .HorizontalAlignment = xlRight
    .VerticalAlignment = xlCenter
    .Font.Bold = True
End With
Columns("D:D").EntireColumn.AutoFit
Range("A1").Select

Application.ScreenUpdating = True

End Sub

Function NombreFichiers(ByVal Pasta As String) As Long
    Dim FSO As Object

    Set FSO = CreateObject("Scripting.filesystemobject")
    NombreFichiers = FSO.GetFolder(Pasta).Files.Count

    Set FSO = Nothing
End Function

 

[John_w]

See if you can adapt the code here for your situation:

How to Print multiple Hyperlink pdf file using VBA?

Hello Everyone . I want to print my hyperlinked all pdf file by 1 Click by using VBA.

www.mrexcel.com

 

[RastaBomboclat]

Hello Dear,

Thank you for your reply. I really appreciate.
Unfortunately running the script, the system retourn an error says:
Run-time error '91'
Objet variable or With block variable not set
This is the line which couse the error is:

CreateObject("Shell.Application").Namespace(Left(PDFfullName, InStrRev(PDFfullName, "\"))).Items.Item(Mid(PDFfullName, InStrRev(PDFfullName, "\") + 1)).InvokeVerb "Print"

 

[John_w]

What is the value of PDFfullName? Is it correct?

 

[RastaBomboclat]

I can't display it. How do I do?

 

[John_w]

Put the cursor on the CreateObject line and press F9 to set a breakpoint there. Run the macro and when the code stops on that line hover the cursor over PDFfullName and its value is displayed.

 

[RastaBomboclat]

What is the value of PDFfullName? Is it correct?

Sorry. I have forgot to change adapt the function as per my sheet structure.
But now I have another exception which is: "Link location not found for cell $B$6"

 

[RastaBomboclat]

Put the cursor on the CreateObject line and press F9 to set a breakpoint there. Run the macro and when the code stops on that line hover the cursor over PDFfullName and its value is displayed.

In fact, after doing that, it giving me the path of my pdf doc without C:\ only the parent-folder, folder, sub-folder and file name.

 

[John_w]

For convenience, here's the code I linked to. This looks for the hyperlinks in column B, which is the same for your sheet.

Public Sub Print_Hyperlink_PDFs()
   
    Dim r As Long
    Dim PDFfile As String
   
    With ActiveSheet
        For r = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
            PDFfile = GetHyperlinkLocation(.Cells(r, "B"))
            If PDFfile <> "" Then
                Print_PDF PDFfile
            Else
                MsgBox "Link location not found for cell " & .Cells(r, "B").Address, vbExclamation
            End If
        Next
    End With
   
End Sub

Private Function GetHyperlinkLocation(cell As Range) As String

    Dim p1 As Long, p2 As Long
   
    With cell.Item(1, 1)
        If .Hyperlinks.Count = 1 Then
            GetHyperlinkLocation = .Hyperlinks(1).Address
        Else
            p1 = InStr(1, .Formula, "HYPERLINK(", vbTextCompare)
            If p1 > 0 Then
                p1 = p1 + Len("HYPERLINK(")
                p2 = InStr(p1, .Formula, ",")
                If p2 > 0 Then
                    GetHyperlinkLocation = Evaluate(Mid(.Formula, p1, p2 - p1))
                End If
            Else
                GetHyperlinkLocation = ""
            End If
        End If
    End With
   
End Function


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

But now I have another exception which is: "Link location not found for cell $B$6"

You'll have to debug the code (press the F8 key on each line), particularly Private Function GetHyperlinkLocation(cell As Range) As String, to see whether it parses the hyperlink (the cell argument) correctly. If the hyperlinks are formulas using the HYPERLINK function then the code can only handle very simple HYPERLINK formulas, otherwise the above message is displayed by the caller.

In fact, after doing that, it giving me the path of my pdf doc without C:\ only the parent-folder, folder, sub-folder and file name.

The path should start with C:\, or other drive letter, otherwise how does it know where the PDF is located?

 

[RastaBomboclat]

You'll have to debug the code (press the F8 key on each line), particularly Private Function GetHyperlinkLocation(cell As Range) As String, to see whether it parses the hyperlink (the cell argument) correctly. If the hyperlinks are formulas using the HYPERLINK function then the code can only handle very simple HYPERLINK formulas, otherwise the above message is displayed by the caller.

By using the Excel HYPERLINK function, the formula and the whole path is displayed in the formula bar.
But I don't use the Hyperlink function, so only the file name is displayed in the formula bar. I sent you my code which handles the creation of said HYPERLINK links.
Can you please try to do a test on your side with my one that I sent to you (the 1st code I sent), just to see what it looks like for you with your solution. Maybe we will manage to solve this isue?

Thanks for yoiur assistance