Advertisement
ASP_Volume2 Databases/ Data Access/ DAO/ ADO #31402

Create PDF from MS Access Report

On a machine where the Adobe PDFWriter is installed, the current printer is swapped out with the PDFWriter and the PDF file is created. The original printer is then restored.

AI

AI Summary: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.

Source Code
original-source
Public Function bGetRegValue(ByVal hKey As Long, ByVal sKey As String, ByVal sSubKey As String) As String
  
  Dim lResult As Long
  Dim phkResult As Long
  Dim dWReserved As Long
  Dim szBuffer As String
  Dim lBuffSize As Long
  Dim szBuffer2 As String
  Dim lBuffSize2 As Long
  Dim lIndex As Long
  Dim lType As Long
  Dim sCompKey As String
  Dim bFound As Boolean
  
  lIndex = 0
  lResult = RegOpenKeyEx(hKey, sKey, 0, 1, phkResult)

  Do While lResult = ERROR_SUCCESS And Not (bFound)
    szBuffer = Space(255)
    lBuffSize = Len(szBuffer)
    szBuffer2 = Space(255)
    lBuffSize2 = Len(szBuffer2)
    lResult = RegEnumValue(phkResult, lIndex, szBuffer, lBuffSize, dWReserved, lType, szBuffer2, lBuffSize2)

    If (lResult = ERROR_SUCCESS) Then
      sCompKey = Left(szBuffer, lBuffSize)

      If (sCompKey = sSubKey) Then
        bGetRegValue = Left(szBuffer2, lBuffSize2 - 1)
        RegCloseKey phkResult
        Exit Function
      End If
    End If
    lIndex = lIndex + 1
    
  Loop
  RegCloseKey phkResult
End Function
Public Function bSetRegValue(ByVal hKey As Long, ByVal lpszSubKey As String, ByVal sSetValue As String, ByVal sValue As String) As Boolean
  
  On Error Resume Next
  Dim phkResult As Long
  Dim lResult As Long
  Dim SA As SECURITY_ATTRIBUTES
  Dim lCreate As Long
  RegCreateKeyEx hKey, lpszSubKey, 0, "", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, SA, phkResult, lCreate
  lResult = RegSetValueEx(phkResult, sSetValue, 0, REG_SZ, sValue, CLng(Len(sValue) + 1))
  RegCloseKey phkResult
  bSetRegValue = (lResult = ERROR_SUCCESS)
  
End Function
Public Function RunReportAsPDF(rptName As String, sPDFPath As String, sPDFName As String)
  '  ---------------------------------
  '  rptName = Microsoft Access report name you
  '  want to create pdf from
  '  sPDFPath = the directory path where you want
  '  to create the pdf file (ex. - "c:\data\")
  '  sPDFName = the name of the pdf file you are
  '  wanting to create (ex. - "file001.pdf")
  '  ---------------------------------
  
  Dim sMyDefPrinter As String
  
  On Error GoTo Err_RunReport
  '  Save current default printer
  sMyDefPrinter = bGetRegValue(HKEY_CURRENT_USER, "Software\Microsoft\WIndows NT\CurrentVersion\Windows", "Device")
  ' Set default printer to PDF Writer
  bSetRegValue HKEY_CURRENT_USER, "Software\Microsoft\Windows NT\CurrentVersion\Windows", "Device", "Acrobat PDFWriter"
  '  Setting value for PDFFileName in the registry stops file dialog box from appearing
  bSetRegValue HKEY_CURRENT_USER, "Software\Adobe\Acrobat PDFWriter", "PDFFileName", sPDFPath + sPDFName
  '  Run the report
  DoCmd.OpenReport rptName, acViewNormal
  
Exit_RunReport:
  ' Restore default printer
  bSetRegValue HKEY_CURRENT_USER, "Software\Microsoft\WIndows NT\CurrentVersion\Windows", "Device", sMyDefPrinter
  Exit Function
Err_RunReport:
  MsgBox Err.Description
  Resume Exit_RunReport
  
End Function
Original Comments (3)
Recovered from Wayback Machine