Save multiple PDF files in shorter time

 2011-11-01    Printing    2    90

OK, no magic involved in this tip. Saving a worksheet as PDF file will take some time, no matter what. You can't do much about that, but when you are saving many worksheets as PDF files you want this process to go as quickly as possible. I was going to save around 3000 PDF files, and suddenly realized that it took quite a long time to save each file, almost 30 seconds, despite the result file being quite small. I assumed that this was because I tried to save the files to a network drive, so I changed the target folder to a local folder on my computer. To my big surprise this did not help at all, the time used to save each PDF document did not change. Then I realized that when saving a PDF file, Excel was probably "printing" it first before saving the result, and this meant that Excel was communicating with the active printer. Since the active printer in this case was a network printer, I tried to change the active printer to a local printer, one that was connected to my laptop. I tested to create some PDF files again, and this time the process of saving each PDF file used around 2 seconds, both when I saved them to a network folder and to a local folder. Below are a few example macros, one showing how you can temporarily change from a network printer before saving many PDF documents, and then restoring the original printer afterwards.

Sub TestSaveAsPDF_CreateFew()
' create one or a few PDF files like this
Dim strFolder As String, strFile As String
    ThisWorkbook.Activate
    If Len(ThisWorkbook.Path) = 0 Then Exit Sub
    
    ' determine the target folder for the pdf files
    strFolder = ThisWorkbook.Path & Application.PathSeparator
    
    ' delete any existing dummy pdf files created earlier
    If Len(Dir("Test_*.pdf")) > 0 Then
        On Error Resume Next
        Kill "Test_*.pdf"
        On Error GoTo 0
    End If
    
    With ThisWorkbook
        strFile = strFolder & "Test_" & .Worksheets(1).Name & ".pdf"
        Application.StatusBar = "Saving file: " & strFile
        If Not SaveAsPDF(.Worksheets(1), strFile, True) Then
            MsgBox "Failed to export worksheet to PDF!", vbInformation
        End If
    End With
    Application.StatusBar = False
End Sub

Sub TestSaveAsPDF_CreateMultiple()
' create multiple pdf files like this
Dim strFolder As String, strFile As String
Dim i As Long, strPrinter As String
    ThisWorkbook.Activate
    If Len(ThisWorkbook.Path) = 0 Then Exit Sub
    
    ' determine the target folder for the pdf files
    strFolder = ThisWorkbook.Path & Application.PathSeparator
    
    ' delete any existing dummy pdf files created earlier
    If Len(Dir("Test_*.pdf")) > 0 Then
        On Error Resume Next
        Kill "Test_*.pdf"
        On Error GoTo 0
    End If
    
    ' save the current active printer
    strPrinter = Application.ActivePrinter
    ' change from a network printer to a local printer
    ' this will speed up the process of creating many PDF documents
    ' you can use any local printer, the one below gives a decent output quality
    Application.ActivePrinter = "Microsoft XPS Document Writer on Ne01:"
    With ThisWorkbook
        For i = 1 To 25 ' count of pdf files to create
            strFile = strFolder & "Test_" & .Worksheets(1).Name & "_" & Format(i, "000") & ".pdf"
            Application.StatusBar = "Saving file: " & strFile
            If Not SaveAsPDF(.Worksheets(1), strFile, False) Then
                MsgBox "Failed to export worksheet to PDF!", vbInformation
                Exit For ' end loop
            End If
        Next i
    End With
    ' restore the original active printer
    Application.ActivePrinter = strPrinter
    Application.StatusBar = False
End Sub

Function SaveAsPDF(ws As Worksheet, strTargetFile As String, Optional blnOpenAfter As Boolean = False) As Boolean
    SaveAsPDF = False
    If ws Is Nothing Then Exit Function ' no worksheet
    If Len(strTargetFile) < 6 Then Exit Function ' no filename
    If Len(Dir(strTargetFile)) > 0 Then Exit Function ' file exists
    
    SaveAsPDF = True
    On Error GoTo ErrorSavingAsPDF
    ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strTargetFile, Quality:=xlQualityMinimum, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=blnOpenAfter
    On Error GoTo 0
    Exit Function
    
ErrorSavingAsPDF:
    SaveAsPDF = False
    Resume Next
End Function


Leave a comment:

Your comment will only be published after it has been moderated and found spam free.
Your e-mail address will only be used to display your Gravatar.

OPE | 2016-02-18 22:29:06 (GMT)

Hi!

Glad it helped you :-)

Your network printer solution is similar to what you could have found here:
http://erlandsendata.no/?p=2100

I use the printer named Microsoft XPS Document Writer, this is normally a local printer on the users system, so no need for the complicated routine to find the correct network printer name.

Jim Palmer | 2016-02-18 19:50:57 (GMT)

The idea of switching to a local printer worked great for me. The PDF files were produced in about 1/10th the time it took while printing to a network printer.

I ran into a challenge when three different users had three different settings for their local printer.
One was Fax on Ne01
another was Fax on Ne02
and the third was Fax on Ne05

I ended up using the following Do Until loop until I found an active printer that didn't cause errors.

Code:

Dim strPrinter As String
Dim newPrinter As String
Dim i, Count, Test As Integer

'save the current active printer
strPrinter = Application.ActivePrinter
' change from a network printer to a local printer
' this will speed up the process of creating many PDF documents
' you can use any local printer, the one below gives a decent output quality

Test = 0
i = 0

Do While Test = 0 ' Keep looping until Test does not equal zero

newPrinter = "Fax on Ne0" & i & ":"
On Error Resume Next

Application.ActivePrinter = newPrinter
If Left(Application.ActivePrinter, 3) = "Fax" Then Test = 1

Debug.Print "I = " & i
Debug.Print Application.ActivePrinter
i = i + 1

Loop