Printing out Excel and PDF files from within Access 2003 1

[vamoose]

Hello, I am using the following code to print out an Excel document from within Access 2003 and it is working great.

If Extension = ".xls" Then
Path = "\\server02\Common\emqc\plants\Setups\Winding\"
Dim appexcel As Object: Set appexcel = CreateObject("Excel.Application")
appexcel.workbooks.Open Path & FilenameSheet
appexcel.Visible = False: appexcel.ActiveWindow.SelectedSheets.PrintOut Copies:=1: Exit Sub
End If

Now I would like to know how to modify this code to print a .PDF document.

Thank you for any help

 

[oharab]

You need some sort of PDF generation software (eg Adobe Acrobat), then you need to find out how to control where that software saves the PDF file to.

For instance, we use Docucom's PDF Driver. To save the PDF to a specific location we have to set certain registry values. Here's my code for using Docucom:

Private Const cKey As String = "HKEY_CURRENT_USER\"
Private Const cDestination As String = "HKEY_CURRENT_USER\Software\Zeon\DocuCom\PDF DRIVER\Destination\"
Private Const cGeneral As String = "HKEY_CURRENT_USER\Software\zeon\docucom\pdf driver\General\"
Private m_sActivePrinter As String

Public Sub PrintOut(Optional ForceIfExists As Boolean = False)

    On Error GoTo PrintOut_Error
    Application.ScreenUpdating = False
    If PDFSetup Then
        m_sActivePrinter = Excel.Application.ActivePrinter
        Excel.Application.ActivePrinter = "DocuCom PDF Driver on LPT1:"
        SetFileSaveLocation (Me.OutputPath)
        Dim bPrintout As Boolean
        If Dir(Me.OutputPath) = "" Then
            bPrintout = True
        Else
            If Not ForceIfExists Then
                If MsgBox("The file """ & Me.OutputPath & """ already exists, do you wish to overwrite it?", vbYesNo Or vbCritical, "PDF Printer") = vbYes Then
                    Kill Me.OutputPath
                    bPrintout = True
                End If
            Else
                Kill Me.OutputPath
                bPrintout = True
            End If
        End If
        If bPrintout Then
            Dim Sht As Excel.Worksheet
            For Each Sht In Me.Worksheets
                Sht.PrintOut
            Next Sht
        End If
    End If

PrintOut_Exit:
    On Error Resume Next
    ResetPDFSettings
    Excel.Application.ActivePrinter = m_sActivePrinter
    Application.ScreenUpdating = True
    Exit Sub

PrintOut_Error:
    Select Case Err
        Case Else
            VBA.MsgBox "Error " & VBA.Err.Number & " (" & VBA.Err.Description & ") in procedure PrintOut of Class Module PDFPrinter"
    End Select
    mStatusBar.SetStatusBar False
    Resume PrintOut_Exit
    Resume

End Sub

Private Sub SetFileSaveLocation(outputFileLocation As String)

    On Error GoTo SetFileSaveLocation_Error


    With CreateObject("WScript.Shell")
        .RegWrite cDestination & "PDFName", outputFileLocation, "REG_SZ"
        .RegWrite cDestination & "NamingMode", "1", "REG_SZ"
        .RegWrite cDestination & "FileExistRule", "2", "REG_SZ"
    End With

SetFileSaveLocation_Exit:
    On Error Resume Next
    Exit Sub

SetFileSaveLocation_Error:
    Select Case Err
        Case Else
            VBA.MsgBox "Error " & VBA.Err.Number & " (" & VBA.Err.Description & ") in procedure SetFileSaveLocation of Class Module PDFPrinter"
    End Select
    Resume SetFileSaveLocation_Exit
    Resume

End Sub

Public Function PDFSetup() As Boolean

Dim bResult As Boolean
    On Error GoTo PDFSetup_Error

    With CreateObject("WScript.Shell")
        .RegWrite cKey & cGeneral, ""
        .RegWrite cKey & cGeneral & "bMSOFFICE", "1", "REG_SZ"
        .RegWrite cKey & cGeneral & "WebViewing", "1", "REG_SZ"
        .RegWrite cKey & cGeneral & "StandardPage", "3", "REG_SZ"
        .RegWrite cKey & cGeneral & "bViewPDF", "0", "REG_SZ"
    End With
    bResult = True
PDFSetup_Exit:
    On Error Resume Next
    PDFSetup = bResult
    Exit Function

PDFSetup_Error:
    Select Case Err
        Case Else
            VBA.MsgBox "Error " & VBA.Err.Number & " (" & VBA.Err.Description & ") in procedure PDFSetup of Class Module PDFPrinter"
    End Select
    Resume PDFSetup_Exit
    Resume
End Function

Private Sub ResetPDFSettings()

    mDebug.PrintOut "PDFPrinter.ResetPDFSettings"
    On Error GoTo ResetPDFSettings_Error
    With CreateObject("WScript.Shell")
        .RegDelete cDestination
        .RegDelete cGeneral
    End With

ResetPDFSettings_Exit:
    On Error Resume Next
    Exit Sub

ResetPDFSettings_Error:
    Select Case Err
        Case Else
            VBA.MsgBox "Error " & VBA.Err.Number & " (" & VBA.Err.Description & ") in procedure ResetPDFSettings of Class Module PDFPrinter"
    End Select
    Resume ResetPDFSettings_Exit
    Resume

End Sub

Whichever software you buy, will require the code modifying to fit it's API. If you buy a popular one (eg Adobe Acrobat (which is quite expensive!), then you will have more chance of finding examples of how to use it.

hth

Ben

----------------------------------------------
Ben O'Hara

http://www.RobotParade.co.uk

We could be confused in exactly the same way, but confusion might be like Nulls, and not comparable.