Print any Hyperlink files to PDF - VBA

[thpwn]

Hello!
Can someone help me:
I would like to print excel file I have as a hyperlink with the name in the file path. also if it is possible to print on a certain paper size, orientation, pagefit and saved in the path B1

[TABLE="class: grid, width: 684"]
<colgroup><col><col span="2"><col></colgroup><tbody>[TR]
[TD]Filepath[/TD]
[TD]C:\Users\xxxx\Desktop\yyyy\[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Name[/TD]
[TD]Extension[/TD]
[TD]Filepath[/TD]
[TD]Hyperlink[/TD]
[/TR]
[TR]
[TD]230.xls[/TD]
[TD].xls[/TD]
[TD]C:\Users\xxxx\Desktop\yyyy\[/TD]
[TD]C:\Users\xxxx\Desktop\yyyy\230.xls[/TD]
[/TR]
[TR]
[TD]231.xls[/TD]
[TD].xls[/TD]
[TD]C:\Users\xxxx\Desktop\yyyy\[/TD]
[TD]C:\Users\xxxx\Desktop\yyyy\231.xls[/TD]
[/TR]
[TR]
[TD]232.xls[/TD]
[TD].xls[/TD]
[TD]C:\Users\xxxx\Desktop\yyyy\[/TD]
[TD]C:\Users\xxxx\Desktop\yyyy\232.xls[/TD]
[/TR]
[TR]
[TD]233.xls[/TD]
[TD].xls[/TD]
[TD]C:\Users\xxxx\Desktop\yyyy\[/TD]
[TD]C:\Users\xxxx\Desktop\yyyy\233.xls[/TD]
[/TR]
[TR]
[TD]234.xls[/TD]
[TD].xls[/TD]
[TD]C:\Users\xxxx\Desktop\yyyy\[/TD]
[TD]C:\Users\xxxx\Desktop\yyyy\234.xls[/TD]
[/TR]
</tbody>[/TABLE]


Thank you

 

[ParamRay]

Try something along these lines.

Public Sub ExportWorkbooks()
  Const strSHEET_NAME = "Sheet1" ' <-- Set name of sheet with hyperlinks
  Dim lngTotalFiles As Long
  Dim lngSavedFiles As Long
  Dim j As Long
  
' Assumes hyperlinks go from cell D3 downwards:
  On Error GoTo ErrorHandler
  With ThisWorkbook.Sheets(strSHEET_NAME)
    For j = 3 To .Cells(.Rows.Count, "D").End(xlUp).Row
      lngTotalFiles = lngTotalFiles + 1
      If ExportWorkbook(.Cells(j, "D").Text) Then
        lngSavedFiles = lngSavedFiles + 1
      End If
    Next j
    MsgBox lngSavedFiles & " of " & lngTotalFiles _
      & " file(s) were exported.", vbInformation
  End With
  Exit Sub

ErrorHandler:
  MsgBox Err.Description, vbExclamation
End Sub

Private Function ExportWorkbook(strFilePath As String) As Boolean
  Dim f As Object
  Dim w As Workbook
  Dim s As Object
  Dim p As String
  
  On Error GoTo ErrorHandler
  Application.DisplayAlerts = False
  Set w = Workbooks.Open(strFilePath, False)
  
  For Each s In w.Sheets
    Application.PrintCommunication = False
    s.PageSetup.Orientation = xlPortrait ' or xlLandscape
    s.PageSetup.PaperSize = xlPaperA4 ' or xlPaperA3, etc.
    s.PageSetup.FitToPagesWide = 1
    s.PageSetup.FitToPagesTall = 1
    Application.PrintCommunication = True
  Next s
  
  Set f = CreateObject("Scripting.FileSystemObject")
  p = f.GetParentFolderName(strFilePath) & "\" & _
      f.GetBaseName(strFilePath) & ".pdf"
  If f.FileExists(p) Then f.DeleteFile p, True
  
  w.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=p, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
  ExportWorkbook = True
  
ExitHandler:
  On Error Resume Next
  w.Close False
  Application.DisplayAlerts = True
  Application.PrintCommunication = True
  Set f = Nothing
  Exit Function
  
ErrorHandler:
  ExportWorkbook = False
  Resume ExitHandler
End Function

 

[thpwn]

Try something along these lines.

Public Sub ExportWorkbooks()
  Const strSHEET_NAME = "Sheet1" ' <-- Set name of sheet with hyperlinks
  Dim lngTotalFiles As Long
  Dim lngSavedFiles As Long
  Dim j As Long
  
' Assumes hyperlinks go from cell D3 downwards:
  On Error GoTo ErrorHandler
  With ThisWorkbook.Sheets(strSHEET_NAME)
    For j = 3 To .Cells(.Rows.Count, "D").End(xlUp).Row
      lngTotalFiles = lngTotalFiles + 1
      If ExportWorkbook(.Cells(j, "D").Text) Then
        lngSavedFiles = lngSavedFiles + 1
      End If
    Next j
    MsgBox lngSavedFiles & " of " & lngTotalFiles _
      & " file(s) were exported.", vbInformation
  End With
  Exit Sub

ErrorHandler:
  MsgBox Err.Description, vbExclamation
End Sub

Private Function ExportWorkbook(strFilePath As String) As Boolean
  Dim f As Object
  Dim w As Workbook
  Dim s As Object
  Dim p As String
  
  On Error GoTo ErrorHandler
  Application.DisplayAlerts = False
  Set w = Workbooks.Open(strFilePath, False)
  
  For Each s In w.Sheets
    Application.PrintCommunication = False
    s.PageSetup.Orientation = xlPortrait ' or xlLandscape
    s.PageSetup.PaperSize = xlPaperA4 ' or xlPaperA3, etc.
    s.PageSetup.FitToPagesWide = 1
    s.PageSetup.FitToPagesTall = 1
    Application.PrintCommunication = True
  Next s
  
  Set f = CreateObject("Scripting.FileSystemObject")
  p = f.GetParentFolderName(strFilePath) & "\" & _
      f.GetBaseName(strFilePath) & ".pdf"
  If f.FileExists(p) Then f.DeleteFile p, True
  
  w.ExportAsFixedFormat _
    Type:=xlTypePDF, _
    Filename:=p, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
  ExportWorkbook = True
  
ExitHandler:
  On Error Resume Next
  w.Close False
  Application.DisplayAlerts = True
  Application.PrintCommunication = True
  Set f = Nothing
  Exit Function
  
ErrorHandler:
  ExportWorkbook = False
  Resume ExitHandler
End Function

Thank you ParamRay, but after i run the program it says that it's 0 from n files exported, and no pdf created.

 

[ParamRay]

Thank you ParamRay, but after i run the program it says that it's 0 from n files exported, and no pdf created.

Please read through the code and make necessary changes to sheet name, column references, etc. The code runs flawlessly at this end...

 

[thpwn]

Please read through the code and make necessary changes to sheet name, column references, etc. The code runs flawlessly at this end...

i made the changes, still doesn't work, i think that's because i have to print excel files and it don't know which sheet.

 

[ParamRay]

Good luck. Check your file paths are correct. Can't help any further.

 

[thpwn]

I tried everything you said, but it does not work. I really need it

 

[ParamRay]

If they are actual hyperlinks (rather than just file paths in a cell), you might try replacing this line:

If ExportWorkbook(.Cells(j, "D").Text) Then

with this line:

If ExportWorkbook(.Cells(j, "D").Hyperlinks(1).Address) Then

 

[thpwn]

solved. Thank you PARAMRAY!