VBA to save print output in same directory

[Tanyaann1995]

Hi,

I am using the below code to print sheet to PDF but this currently only prints it and asks for the link to save it in. Is there a way to change the below code to just directly save the PDF in the same folder after printing?

Sub pdf()
Dim strPrinterName As String

On Error Resume Next
PrinterName = "Microsoft Print to PDF"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
PrinterName, collate:=True

End Sub

 

[John_w]

As a start, save the active sheet as a PDF with the macro recorder running.

 

[Tanyaann1995]

As a start, save the active sheet as a PDF with the macro recorder running.

Hi John,

I've tried with the macro recorder running but the code that I get will just print the sheet to PDF.

Sub Macro6()
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
End Sub

I want the sheet to be printed to PDF and then saved in the same folder.

 

[Tanyaann1995]

Hi John,

I've tried with the macro recorder running but the code that I get will just print the sheet to PDF.

Sub Macro6()
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
IgnorePrintAreas:=False
End Sub

I want the sheet to be printed to PDF and then saved in the same folder.

Hi John,

Please help me with this code.

 

[John_w]

Try this macro, which saves the active sheet(s) as "Sheet(s).pdf" in the same folder as the workbook and prints them on the specified printer.

Public Sub Print_and_Save_As_PDF()
    
    Dim PDFfile As String
    Dim CurrentPrinterNe As String, PrinterNe As String
    
    'Save the active sheet(s) as a PDF file
    
    PDFfile = ActiveWorkbook.Path & "\Sheet(s).pdf"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfile, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    'Save current printer
    
    CurrentPrinterNe = Application.ActivePrinter

    'Get the full name of the specified printer, including its Nexx: network port, and make it the active printer
    
    PrinterNe = FindPrinter("Your printer name here")   'CHANGE THIS

    'Print the active sheet(s) on the specified printer

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

    'Restore current printer
    
    Application.ActivePrinter = CurrentPrinterNe

End Sub


'Written: November 28, 2009
'Author:  Leith Ross
'Summary: Finds a printer by name and returns the printer name and port number.

Public Function FindPrinter(ByVal PrinterName As String) As String

    'This works with Windows 2000 and up
    
    Dim Arr As Variant
    Dim Device As Variant
    Dim Devices As Variant
    Dim printer As String
    Dim RegObj As Object
    Dim RegValue As String
    Const HKEY_CURRENT_USER = &H80000001
    
    Set RegObj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    RegObj.enumValues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Devices, Arr
    
    For Each Device In Devices
        RegObj.getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Device, RegValue
        printer = Device & " on " & Split(RegValue, ",")(1)
        'If InStr(1, Printer, PrinterName, vbTextCompare) > 0 Then  'original code
        If StrComp(Device, PrinterName, vbTextCompare) = 0 Then
            FindPrinter = printer
            Exit Function
        End If
    Next
      
End Function

 

[Tanyaann1995]

Try this macro, which saves the active sheet(s) as "Sheet(s).pdf" in the same folder as the workbook and prints them on the specified printer.

Public Sub Print_and_Save_As_PDF()
   
    Dim PDFfile As String
    Dim CurrentPrinterNe As String, PrinterNe As String
   
    'Save the active sheet(s) as a PDF file
   
    PDFfile = ActiveWorkbook.Path & "\Sheet(s).pdf"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfile, _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

    'Save current printer
   
    CurrentPrinterNe = Application.ActivePrinter

    'Get the full name of the specified printer, including its Nexx: network port, and make it the active printer
   
    PrinterNe = FindPrinter("Your printer name here")   'CHANGE THIS

    'Print the active sheet(s) on the specified printer

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

    'Restore current printer
   
    Application.ActivePrinter = CurrentPrinterNe

End Sub


'Written: November 28, 2009
'Author:  Leith Ross
'Summary: Finds a printer by name and returns the printer name and port number.

Public Function FindPrinter(ByVal PrinterName As String) As String

    'This works with Windows 2000 and up
   
    Dim Arr As Variant
    Dim Device As Variant
    Dim Devices As Variant
    Dim printer As String
    Dim RegObj As Object
    Dim RegValue As String
    Const HKEY_CURRENT_USER = &H80000001
   
    Set RegObj = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    RegObj.enumValues HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Devices, Arr
   
    For Each Device In Devices
        RegObj.getstringvalue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Devices", Device, RegValue
        printer = Device & " on " & Split(RegValue, ",")(1)
        'If InStr(1, Printer, PrinterName, vbTextCompare) > 0 Then  'original code
        If StrComp(Device, PrinterName, vbTextCompare) = 0 Then
            FindPrinter = printer
            Exit Function
        End If
    Next
     
End Function

Hi John, Thanks this worked