Using MS Access/Command Line process

Advertisement


Question
Hi Julie.
I have an Access 2003 database (running in Windows XP) with a form that the user prints via a button that runs a macro to print just the selected record. I would like to also print a PDF with a name based on the contents of a form field called [filename] but I don't know how to pass that field value on. I tried focussing on the [filename] field and then executing the macro command "RunApp" with the following: Acrord32.exe /t [filename], but it's not getting the [filename] value and nothing happens. I'm doing it this way so that if the file exists it gets printed but if it doesn't then the macro simply ends.
Thanks for considering this.

Answer
Hi Chris,

Thanks for the question.

My apologies with the delay.

First of all, you may need to reference where you are getting the [filename] field from i.e. if it is from a form: Forms!form1![filename]

If that does not work, it maybe the code.

I used to use the following code to achieve this from Stephen Lebans:

http://www.lebans.com/reporttopdf.htm

This code from Stephen I have included below the ***.


With the later versions though you can convert directly to PDF by using the Outputto

Private Sub Command14_Click()
DoCmd.OutputTo acOutputReport, "Name", acFormatPDF, "dates.pdf"
End Sub

Note

You can save as a PDF or XPS file from a 2007 Microsoft Office system program only after you install an add-in. For more information, search for "Enable support for other file formats, such as PDF and XPS" on the Office Web site.

Much simpler, but I realize not much help if you do not have Microsoft Access 2007.

************************************

'DEVELOPED AND TESTED UNDER MICROSOFT ACCESS 97 through A2003
'
'Copyright: Stephen Lebans - Lebans Holdings 1999 Ltd.


'Distribution:

' Plain and simple you are free to use this source within your own
' applications. whether private or commercial, without cost or obligation, other that keeping
' the copyright notices intact. No public notice of copyright is required.
' You may not resell this source code by itself or as part of a collection.
' You may not post this code or any portion of this code in electronic format.
' The source may only be downloaded from:
' www.lebans.com
'
'Name:      ConvertReportToPDF
'
'Version:   7.51
'
'Purpose:
'
'а1) Export report to Snapshot and then to PDF. Output exact duplicate of a Report to PDF.
'
'ннннннннннннннннннннннннннннннннннннннннннннннннна
'
'Author:    Stephen Lebans
'
'Email:     Stephen@lebans.com
'
'Web Site:  www.lebans.com
'
'Date:      Feb 21, 2006, 11:11:11 AM
'
'Dependencies: DynaPDF.dll  StrStorage.dll  clsCommonDialog
'
'Inputs:    See inline Comments for explanation

'Output:    See inline Comments for explanation
'
'Credits:   Anyone who wants some!
'
'BUGS:      Please report any bugs to my email address.
'
'What's Missing:
'          Enhanced Error Handling
'
'How it Works:
' A SnapShot file is created in the normal manner by code like:
'       'Export the selected Report to SnapShot format
'       DoCmd.OutputTo acOutputReport, rptName, "SnapshotFormat(*.snp)", _
'       strPathandFileName
'
' rptName is the desired Report we are working with.
' strPathandFileName can be anything, in this Class it is a
' Temporary FileName and Path created with calls to the
' GetTempPath and GetUniqueFileName API's.
'
' We then pass the FileName to the SetupDecompressOrCopyFile API.
' This will decompress the original SnapShot file into a
' Temporary file with the same name but a "tmp" extension.
'
' The decompressed Temp SnapShot file is then passed to the
' ConvertUncompressedSnapshotToPDF function exposed by the StrStorage DLL.
' The declaration for this call is at the top of this module.
' The function uses the Structured Storage API's to
' open and read the uncompressed Snapshot file. Within this file,
' there is one Enhanced Metafile for each page of the original report.
' Additionally, there is a Header section that contains, among other things,
' a copy of the Report's Printer Devmode structure. We need this to
' determine the page size of the report.

'The StrStorage DLL exposes one function.
'Public Function ConvertUncompressedSnapshotToPDF( _
'UnCompressedSnapShotName As String, _
'OutputPDFname As String = "", _
'Optional CompressionLevel As Long = 0, _
'Optional PasswordOwner As String = "" _
'Optional PasswordOpenAs String = "" _
'Optional PasswordRestrictions as Long = 0, _
'Optional PDFNoFontEmbedding As Long = 0 _
') As Boolean

' Now we call the ConvertUncompressedSnapshotToPDF funtion exposed by the StrStorage DLL.
'
'blRet = ConvertUncompressedSnapshot(sFileName as String, sPDFFileName as String)
'
'
'Have Fun!
'
'
'
' ******************************************************



Public Declare Function ConvertUncompressedSnapshot Lib "StrStorage.dll" _
(ByVal UnCompressedSnapShotName As String, _
ByVal OutputPDFname As String, _
Optional ByVal CompressionLevel As Long = 0, _
Optional ByVal PasswordOwner As String = "", _
Optional ByVal PasswordOpen As String = "", _
Optional ByVal PasswordRestrictions As Long = 0, _
Optional PDFNoFontEmbedding As Long = 0 _
) As Boolean

' For debugging with Visual C++
'Lib "C:\VisualCsource\Debug\StrStorage.dll"

Private Declare Function ShellExecuteA Lib "shell32.dll" _
(ByVal hWnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Private Declare Function LoadLibrary Lib "kernel32" _
Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long

Private Declare Function FreeLibrary Lib "kernel32" _
(ByVal hLibModule As Long) As Long

Private Declare Function GetTempPath Lib "kernel32" _
Alias "GetTempPathA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long

Private Declare Function GetTempFileName _
Lib "kernel32" Alias "GetTempFileNameA" _
(ByVal lpszPath As String, _
ByVal lpPrefixString As String, _
ByVal wUnique As Long, _
ByVal lpTempFileName As String) As Long

Private Declare Function SetupDecompressOrCopyFile _
Lib "setupAPI" _
Alias "SetupDecompressOrCopyFileA" ( _
ByVal SourceFileName As String, _
ByVal TargetFileName As String, _
ByVal CompressionType As Integer) As Long

Private Declare Function SetupGetFileCompressionInfo _
Lib "setupAPI" _
Alias "SetupGetFileCompressionInfoA" ( _
ByVal SourceFileName As String, _
TargetFileName As String, _
SourceFileSize As Long, _
DestinationFileSize As Long, _
CompressionType As Integer _
) As Long


'Compression types
Private Const FILE_COMPRESSION_NONE = 0
Private Const FILE_COMPRESSION_WINLZA = 1
Private Const FILE_COMPRESSION_MSZIP = 2

Private Const Pathlen = 256
Private Const MaxPath = 256


' Allow user to set FileName instead
' of using API Temp Filename or
' popping File Dialog Window
Private mSaveFileName As String

' Full path and name of uncompressed SnapShot file
Private mUncompressedSnapFile As String

' Name of the Report we ' working with
Private mReportName As String

' Instance returned from LoadLibrary calls
Private hLibDynaPDF As Long
Private hLibStrStorage As Long


Public Function ConvertReportToPDF( _
Optional RptName As String = "", _
Optional SnapshotName As String = "", _
Optional OutputPDFname As String = "", _
Optional ShowSaveFileDialog As Boolean = False, _
Optional StartPDFViewer As Boolean = True, _
Optional CompressionLevel As Long = 0, _
Optional PasswordOwner As String = "", _
Optional PasswordOpen As String = "", _
Optional PasswordRestrictions As Long = 0, _
Optional PDFNoFontEmbedding As Long = 0 _
) As Boolean


' RptName is the name of a report contained within this MDB
' SnapshotName is the name of an existing Snapshot file
' OutputPDFname is the name you select for the output PDF file
' ShowSaveFileDialog is a boolean param to specify whether or not to display
' the standard windows File Dialog window to select an exisiting Snapshot file
' CompressionLevel - not hooked up yet
' PasswordOwner  - not hooked up yet
' PasswordOpen - not hooked up yet
' PasswordRestrictions - not hooked up yet
' PDFNoFontEmbedding - Do not Embed fonts in PDF. Set to 1 to stop the
' default process of embedding all fonts in the output PDF. If you are
' using ONLY - any of the standard Windows fonts
' using ONLY - any of the standard 14 Fonts natively supported by the PDF spec
'The 14 Standard Fonts
'All version of Adobe's Acrobat support 14 standard fonts. These fonts are always available
'independent whether they're embedded or not.
'Family name PostScript name Style
'Courier Courier fsNone
'Courier Courier-Bold fsBold
'Courier Courier-Oblique fsItalic
'Courier Courier-BoldOblique fsBold + fsItalic
'Helvetica Helvetica fsNone
'Helvetica Helvetica-Bold fsBold
'Helvetica Helvetica-Oblique fsItalic
'Helvetica Helvetica-BoldOblique fsBold + fsItalic
'Times Times-Roman fsNone
'Times Times-Bold fsBold
'Times Times-Italic fsItalic
'Times Times-BoldItalic fsBold + fsItalic
'Symbol Symbol fsNone, other styles are emulated only
'ZapfDingbats ZapfDingbats fsNone, other styles are emulated only




Dim s As String
Dim blRet As Boolean
' Let's see if the DynaPDF.DLL is available.
blRet = LoadLib()
If blRet = False Then
   ' Cannot find DynaPDF.dll or StrStorage.dll file
   Exit Function
End If

On Error GoTo ERR_CREATSNAP

Dim strPath  As String
Dim strPathandFileName  As String
Dim strEMFUncompressed As String

Dim sOutFile As String
Dim lngRet As Long

' Init our string buffer
strPath = Space(Pathlen)

'Save the ReportName to a local var
mReportName = RptName

' Let's kill any existing Temp SnapShot file
If Len(mUncompressedSnapFile & vbNullString) > 0 Then
   Kill mUncompressedSnapFile
   mUncompressedSnapFile = ""
End If

' If we have been passed the name of a Snapshot file then
' skip the Snapshot creation process below
If Len(SnapshotName & vbNullString) = 0 Then
     
   ' Make sure we were passed a ReportName
   If Len(RptName & vbNullString) = 0 Then
       ' No valid parameters - FAIL AND EXIT!!
       ConvertReportToPDF = ""
       Exit Function
   End If
       
   ' Get the Systems Temp path
   ' Returns Length of path(num characters in path)
   lngRet = GetTempPath(Pathlen, strPath)
   ' Chop off NULLS and trailing "\"
   strPath = left(strPath, lngRet) & Chr(0)
   
   ' Now need a unique Filename
   ' locked from a previous aborted attemp.
   ' Needs more work!
   strPathandFileName = GetUniqueFilename(strPath, "SNP" & Chr(0), "snp")
   
   ' Export the selected Report to SnapShot format
   DoCmd.OutputTo acOutputReport, RptName, "SnapshotFormat(*.snp)", _
      strPathandFileName
   ' Make sure the process has time to complete
   DoEvents

Else
   strPathandFileName = SnapshotName

End If

' Let's decompress into same filename but change type to ".tmp"
'strEMFUncompressed = Mid(strPathandFileName, 1, Len(strPathandFileName) - 3)
'strEMFUncompressed = strEMFUncompressed & "tmp"
Dim sPath As String * 512
lngRet = GetTempPath(512, sPath)

strEMFUncompressed = GetUniqueFilename(sPath, "SNP", "tmp")

lngRet = SetupDecompressOrCopyFile(strPathandFileName, strEMFUncompressed, 0&)

If lngRet <> 0 Then
   Err.Raise vbObjectError + 525, "ConvertReportToPDF.SetupDecompressOrCopyFile", _
   "Sorry...cannot Decompress SnapShot File" & vbCrLf & _
   "Please select a different Report to Export"
End If

' Set our uncompressed SnapShot file name var
mUncompressedSnapFile = strEMFUncompressed

' Remember to Cleanup our Temp SnapShot File if we were NOT passed the
' Snapshot file as the optional param
If Len(SnapshotName & vbNullString) = 0 Then
   Kill strPathandFileName
End If


' Do we name output file the same as the input file name
' and simply change the file extension to .PDF or
' do we show the File Save Dialog
If ShowSaveFileDialog = False Then

   ' let's decompress into same filename but change type to ".tmp"
   ' But first let's see if we were passed an output PDF file name
   If Len(OutputPDFname & vbNullString) = 0 Then
       sOutFile = Mid(strPathandFileName, 1, Len(strPathandFileName) - 3)
       sOutFile = sOutFile & "PDF"
   Else
       sOutFile = OutputPDFname
   End If

Else
   ' Call File Save Dialog
   sOutFile = fFileDialog()
   If Len(sOutFile & vbNullString) = 0 Then
       Exit Function
   End If

End If

' Call our function in the StrStorage DLL
' Note the Compression and Password params are not hooked up yet.
blRet = ConvertUncompressedSnapshot(mUncompressedSnapFile, sOutFile, _
CompressionLevel, PasswordOwner, PasswordOpen, PasswordRestrictions, PDFNoFontEmbedding)

If blRet = False Then
Err.Raise vbObjectError + 526, "ConvertReportToPDF.ConvertUncompressedSnaphot", _
   "Sorry...damaged SnapShot File" & vbCrLf & _
   "Please select a different Report to Export"
End If

' Do we open new PDF in registered PDF viewer on this system?
If StartPDFViewer = True Then
ShellExecuteA Application.hWndAccessApp, "open", sOutFile, vbNullString, vbNullString, 1
End If

' Success
ConvertReportToPDF = True


EXIT_CREATESNAP:

' Let's kill any existing Temp SnapShot file
'If Len(mUncompressedSnapFile & vbNullString) > 0 Then
    On Error Resume Next
  Kill mUncompressedSnapFile
   mUncompressedSnapFile = ""
'End If

' If we aready loaded then free the library
If hLibStrStorage <> 0 Then
   hLibStrStorage = FreeLibrary(hLibStrStorage)
End If

If hLibDynaPDF <> 0 Then
   hLibDynaPDF = FreeLibrary(hLibDynaPDF)
End If

Exit Function

ERR_CREATSNAP:
MsgBox Err.Description, vbOKOnly, Err.Source & ":" & Err.Number
mUncompressedSnapFile = ""
ConvertReportToPDF = False
Resume EXIT_CREATESNAP

End Function



Private Function LoadLib() As Boolean
Dim s As String
Dim blRet As Boolean

On Error Resume Next

LoadLib = False

' If we aready loaded then free the library
If hLibDynaPDF <> 0 Then
   hLibDynaPDF = FreeLibrary(hLibDynaPDF)
End If


' Our error string
s = "Sorry...cannot find the DynaPDF.dll file" & vbCrLf
s = s & "Please copy the DynaPDF.dll file to your Windows System32 folder or into the same folder as this Access MDB."

' OK Try to load the DLL assuming it is in the Window System folder
hLibDynaPDF = LoadLibrary("DynaPDF.dll")
If hLibDynaPDF = 0 Then
   ' See if the DLL is in the same folder as this MDB
   ' CurrentDB works with both A97 and A2K or higher
   hLibDynaPDF = LoadLibrary(CurrentDBDir() & "DynaPDF.dll")
   If hLibDynaPDF = 0 Then
       MsgBox s, vbOKOnly, "MISSING DynaPDF.dll FILE"
       LoadLib = False
       Exit Function
   End If
End If


' Our error string
s = "Sorry...cannot find the StrStorage.dll file" & vbCrLf
s = s & "Please copy the StrStorage.dll file to your Windows System32 folder or into the same folder as this Access MDB."

' ** Commented out for Debugging only - Must be active
' ***************************************************************************
'
' OK Try to load the DLL assuming it is in the Window System folder
hLibStrStorage = LoadLibrary("StrStorage.dll")
If hLibStrStorage = 0 Then
   ' See if the DLL is in the same folder as this MDB
   ' CurrentDB works with both A97 and A2K or higher
   hLibStrStorage = LoadLibrary(CurrentDBDir() & "StrStorage.dll")
   If hLibStrStorage = 0 Then
       MsgBox s, vbOKOnly, "MISSING StrStorage.dll FILE"
       Exit Function
   End If
End If


' RETURN SUCCESS
LoadLib = True
End Function


'******************** Code Begin ****************
'Code courtesy of
'Terry Kreft & Ken Getz
'
Private Function CurrentDBDir() As String
Dim strDBPath As String
Dim strDBFile As String
   strDBPath = CurrentDb.Name
   strDBFile = Dir(strDBPath)
   CurrentDBDir = left$(strDBPath, Len(strDBPath) - Len(strDBFile))
End Function
'******************** Code End ****************



Private Function GetUniqueFilename(Optional path As String = "", _
Optional Prefix As String = "", _
Optional UseExtension As String = "") _
As String

' originally Posted by Terry Kreft
' to: comp.Databases.ms -Access
' Subject:  Re: Creating Unique filename ??? (Dev code)
' Date: 01/15/2000
' Author: Terry Kreft <terry.kreft@mps.co.uk>

' SL Note: Input strings must be NULL terminated.
' Here it is done by the calling function.

 Dim wUnique As Long
 Dim lpTempFileName As String
 Dim lngRet As Long

 wUnique = 0
 If path = "" Then path = CurDir
 lpTempFileName = String(MaxPath, 0)
 lngRet = GetTempFileName(path, Prefix, _
         wUnique, lpTempFileName)

 lpTempFileName = left(lpTempFileName, _
         InStr(lpTempFileName, Chr(0)) - 1)
 Call Kill(lpTempFileName)
 If Len(UseExtension) > 0 Then
   lpTempFileName = left(lpTempFileName, Len(lpTempFileName) - 3) & UseExtension
 End If
 GetUniqueFilename = lpTempFileName
End Function


Private Function fFileDialog() As String
' Calls the API File Save Dialog Window
' Returns full path to new File

On Error GoTo Err_fFileDialog

' Call the File Common Dialog Window
Dim clsDialog As Object
Dim strTemp As String
Dim strFname As String

Set clsDialog = New clsCommonDialog

' Fill in our structure
' I'll leave in how to select Gif and Jpeg to
' show you how to build the Filter in case you want
' to use this code in another project.
clsDialog.Filter = "PDF (*.PDF)" & Chr$(0) & "*.PDF" & Chr$(0)
'clsDialog.Filter = clsDialog.Filter & "Gif (*.GIF)" & Chr$(0) & "*.GIF" & Chr$(0)
'clsDialog.Filter = "ALL (*.*)" & Chr$(0) & "*.*" & Chr$(0)
clsDialog.hdc = 0
clsDialog.MaxFileSize = 256
clsDialog.Max = 256
clsDialog.FileTitle = vbNullString
clsDialog.DialogTitle = "Please Select a path and Enter a Name for the PDF File"
clsDialog.InitDir = vbNullString
clsDialog.DefaultExt = vbNullString

' Display the File Dialog
clsDialog.ShowSave

' See if user clicked Cancel or even selected
' the very same file already selected
strFname = clsDialog.FileName
'If Len(strFname & vbNullString) = 0 Then
' Raise the exception
' Err.Raise vbObjectError + 513, "clsPrintToFit.fFileDialog", _
 '"Please type in a Name for a New File"
'End If

' Return File Path and Name
fFileDialog = strFname

Exit_fFileDialog:

Err.Clear
Set clsDialog = Nothing
Exit Function

Err_fFileDialog:
fFileDialog = ""
MsgBox Err.Description, vbOKOnly, Err.Source & ":" & Err.Number
Resume Exit_fFileDialog

End Function




Public Function fFileDialogSnapshot() As String
' Calls the API File Open Dialog Window
' Returns full path to existing Snapshot File

On Error GoTo Err_fFileDialog

' Call the File Common Dialog Window
Dim clsDialog As Object
Dim strTemp As String
Dim strFname As String

Set clsDialog = New clsCommonDialog

' Fill in our structure
' I'll leave in how to select Gif and Jpeg to
' show you how to build the Filter in case you want
' to use this code in another project.
clsDialog.Filter = "SNAPSHOT (*.SNP)" & Chr$(0) & "*.SNP" & Chr$(0)
'clsDialog.Filter = "ALL (*.*)" & Chr$(0) & "*.*" & Chr$(0)
clsDialog.hdc = 0
clsDialog.MaxFileSize = 256
clsDialog.Max = 256
clsDialog.FileTitle = vbNullString
clsDialog.DialogTitle = "Please Select a Snapshot File"
clsDialog.InitDir = vbNullString
clsDialog.DefaultExt = vbNullString

' Display the File Dialog
clsDialog.ShowOpen

' See if user clicked Cancel or even selected
' the very same file already selected
strFname = clsDialog.FileName
If Len(strFname & vbNullString) = 0 Then
' Do nothing. Add your desired error logic here.
End If

' Return File Path and Name
fFileDialogSnapshot = strFname

Exit_fFileDialog:

Err.Clear
Set clsDialog = Nothing
Exit Function

Err_fFileDialog:
fFileDialogSnapshot = ""
MsgBox Err.Description, vbOKOnly, Err.Source & ":" & Err.Number
Resume Exit_fFileDialog

End Function



Public Function fFileDialogSavePDFname() As String
' Calls the API File Open Dialog Window
' Returns full path to existing Snapshot File

On Error GoTo Err_fFileDialog

' Call the File Common Dialog Window
Dim clsDialog As Object
Dim strTemp As String
Dim strFname As String

Set clsDialog = New clsCommonDialog

' Fill in our structure
' I'll leave in how to select Gif and Jpeg to
' show you how to build the Filter in case you want
' to use this code in another project.
clsDialog.Filter = "PDF (*.PDF)" & Chr$(0) & "*.PDF" & Chr$(0)
'clsDialog.Filter = "ALL (*.*)" & Chr$(0) & "*.*" & Chr$(0)
clsDialog.hdc = 0
clsDialog.MaxFileSize = 256
clsDialog.Max = 256
clsDialog.FileTitle = vbNullString
clsDialog.DialogTitle = "Please Select a name for the PDF File"
clsDialog.InitDir = vbNullString
clsDialog.DefaultExt = vbNullString



' Display the File Dialog
clsDialog.ShowOpen

' See if user clicked Cancel or even selected
' the very same file already selected
strFname = clsDialog.FileName
If Len(strFname & vbNullString) = 0 Then
' Do nothing. Add your desired error logic here.
End If

' Return File Path and Name
fFileDialogSavePDFname = strFname

Exit_fFileDialog:

Err.Clear
Set clsDialog = Nothing
Exit Function

Err_fFileDialog:
fFileDialogSavePDFname = ""
MsgBox Err.Description, vbOKOnly, Err.Source & ":" & Err.Number
Resume Exit_fFileDialog

End Function

********
Regards

Julie

Using MS Access

All Answers


Answers by Expert:


Ask Experts

Volunteer


Julie Misson

Expertise

My area of expertise is Microsoft Access 2000-2007. I have been building microsoft databases for the past twelve years. I would be competent in answering questions from novice Access 2000 users to the more advanced including VBA. If I cannot help, I am more than likely be able to point you to websites that can.

Experience

I have a Microsoft Access business where I build database for small businesses. These are usually one off designs, where there is no off the shelf software avaliable to meet the business needs. I also teach Microsft Access to beginners. I am the owner of the www.simply-access.com website.

Education/Credentials
Self taught in Microsoft Access. Have done some units in normalisation and SQL, but most of what I know I have learnt from books originally and more recently the Internet.

©2016 About.com. All rights reserved.