473,700 Members | 2,661 Online
Bytes | Software Development & Data Engineering Community
+ Post

Home Posts Topics Members FAQ

How do I create pdf reports from Access?

dog
I've seen plenty of articles on this topic but none of them have been
able to solve my problem.

I am working with an Access 97 database on an NT4.0 machine, which has
many Access reports.
I want my users to be able to select a report, click on a command
button on a form, which will then automatically create the report as a
pdf file and save it to the user's machine.

I am using Adobe Acrobat (5.0 I think) and have Adobe Distiller as a
printer. I can get my code to change my default printer to Adobe
Distiller, and using the Docmd.OutputTo, it will begin to create the
file.
However what then happens is: a ‘Save File As' dialog box appears,
prompts me to click on ‘OK' and when I do, the report is created and
saved, but Adobe then open the report. I want my code to be able to
override this dialog box and automatically save the report with a file
name I put in a variable, and stop Adobe from opening at the end.
I have looked at using the properties in Adobe but they don't seem to
help.

Is what I want to do possible? I don't know and unfortunately I work
for a large organisation and have to use Adobe and no other product –
free or not.

I'm fairly new to VBA programming and messing with the registry is
beyond me so if anyone has any ideas, or better still has the code, it
would be much appreciated.

Many Thanks.
Nov 13 '05 #1
7 8861
RE/
However what then happens is: a ?Save File As' dialog box appears,
prompts me to click on ?OK' and when I do, the report is created and
saved, but Adobe then open the report. I want my code to be able to
override this dialog box and automatically save the report with a file
name I put in a variable, and stop Adobe from opening at the end.
I have looked at using the properties in Adobe but they don't seem to
help.

Is what I want to do possible? I don't know and unfortunately I work
for a large organisation and have to use Adobe and no other product ?
free or not.


Assuming that all users have PdfWriter (couple hundred dollars per seat)
installed on their PC's, what you do is use the registry as your interface to
Acrobat. You set parms for file name and a couple other things and then just
let it rip.

Here's some code that includes handling .PDF. It's a class and is probably
wretched excess for what you want to do...but the code is there TB teased out as
needed. What's missing is the code to look at the user's printers and figure
out whether PdfWriter is available. I do that outside of the class BC I use
the results to enable/disable the "PDF" button/option on the screen in question.

If it looks promising, let me know and we'll figure out a way for me to email it
as an attachment - since our respective email programs have probably made hash
out of the line breaks...

=============== =============== =============== =============== =============== =====
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "clsReportPrint er"
Attribute VB_GlobalNameSp ace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredI d = False
Attribute VB_Exposed = False
Option Compare Database ' Next available line# series = 8000
Option Explicit

Private Const mVersionNumber = "2.1c" 'Rearranged Types/Constants:
wasn't compiling after decompile because definition of constant didn't preceede
use of same.
Private Const mModuleName = "clsReportPrint er"

' PURPOSE: To provide a way to print MS Access reports to named printers
' and to coerce output characteristics like paper size and
orientation.
'
' Also enables batch printing to Adobe's PDF Writer by supressing
' it's common file dialog and programaticaly supplying file paths.
'
' Intended particularly for batch operations in which
' we need to print many reports, typically looping through
' a work table that contains names of reports to be printed
' along with desired paper size, orientation, and copies.
'
' Also intended to address a recurrant problem in which
' a user changes their system default printer and any reports
' that are set up for, say, legal/landscape, automatically revert
' to the new printer's default settings (usually letter/portrait).
'
' ERRORS: - All error checking is postponed until the calling app invokes
the .PrintReport method.
' After the .PrintReport method has been invoked, the calling app
is responsible for checking
' the .ErrorCount property and displaying .ErrorList if there are
any errors.
' - All errors are 'Fatal' in that no printing will take place if
there is even a single error.
' - Error messages may be sent to up to three places
' > All errors get written to the .ErrorList property, which is
available to the calling
' app once the .PrintReport method has been invoked.
' > Runtime/program errors also bubble up to the calling routine
as trappable errors
' > Runtime/program errors also get written to a log file in the
same directory as the
' calling application unless the user specifies another path via
the .ErrorLogPath property
' - If no printer is installed on the PC, only that condition is
reported, but all other checking
' is suppressed.
'
' METHODS: .PrintReport Causes report to be printed once all needed
properties are set
'
' PROPERTIES
' REQUIRED: -> .ReportName String containing name of report to be printed

' OPTIONAL:
' -> .PdfDir A path to the directory into which a .PDF file
' will be written to. Should NOT include the
name of the file.
' Defaults to application directory.
' e.g. C:\TEMP is correct. C:\TEMP\Whateve r.PDF
is incorrect.
' -> .PrinterName String containing the UNC of the printer. If
not supplied,
' PC's default printer is used. If no default
printer, an error
' is reported.
' -> .ErrorLogPath String telling where to write error log for
program errors
' seldom actually used, since most errors are data
errors and written
' to the .ErrorList....u seful, however, in case
the the code generates
' a runtime error and you want a record. Runtime
errors also
' bubble up to the calling routine where they can
be trapped/displayed.
' Defaults to application directory.
' -> (Any and all parameters used in setting up a printer. e.g.
..Copies,
' .Orientation, .PaperSize, and so-forth.)
' Refer to Appendix A of documentation for
details.
' READ-ONLY:
' <- .ErrorCount Numeric containing the number (if any) of errors
encountered.
' If .ErrorCount>0, the report did not get printed
' <- .ErrorList String containing a description of each error
encountered.
'
' =============== > NEED MORE PROPERTY DESCRIPTIONS
<============== =====
'
'
' DEFAULTS (set in Class_Initializ e):
' .PrinterName=(n ame of PC's 'Default' printer)
' .Collate=False
' .Copies=1
' .Color=Monochro me
' .DefaultSource= Auto
' .Duplex=Simplex
' .GetPdfFileName From=Report's Caption
' .Orientation=Po rtrait
' .PaperSize=Lett er
' .PdfDir=(applic ation's directory)
' .PrinterName=PC 's default printer
' .PrintQuality=H igh
'
' REQUIRES: - A reference to 'Microsoft Active-X Data Objects 2.1 Library'
'
' NOTES: 1) While the class is having properties assigned, it will accept
just about anything
' for any property. All of the validation is done when the
..PrintReport method is invoked.
'
' HOW TO USE: 1) Getting it into your app:
' - Open up a code window by doubleclicking one of the modules
' - Use File/Import File to import clsReportPrinte r.cls
' NB: Importing directly from another Access app will NOT
work...
' ...somethng to do with invisible header information that
gets
' lost when importing from an Access app...must be imported
from
' a text file.
' - Do a Debug/Compile to make sure everyting is OK.
'
' 2) Invoking it to print a report:
' - The clsReportPrinte r object can be instantiated once, and
then used to print many reports.
' - Sample code for printing the same report four times using
different options,
' and then printing a second report:
'
'
=============== =============== =============== =============== =========
' Sub ReportPrintExam ple()
'
' Dim myReportPrinter As clsReportPrinte r
'
' Set myReportPrinter = New clsReportPrinte r
'
' With myReportPrinter
' .ReportName = "rptBillableHou rsByDay"
' .PrintReport 'Report goes to
default printer in default orientation (portrait)
' If .ErrorCount > 0 Then 'using report's
..Caption for file name if default is PDF Writer.
' MsgBox .ErrorList, vbCritical, "Print Failed"
' End If
'
' .PrinterName = "Acrobat PDFWriter"
' .PdfDir = "C:\Temp"
' .GetPdfFileName From = rpGetFromReport Name
' .PrintReport 'Report goes to
..PDF file using report's object name as file name.
' If .ErrorCount > 0 Then
' MsgBox .ErrorList, vbCritical, "Print Failed"
' End If
'
' .GetPdfFileName From = rpGetFromReport Caption
' .LaunchAcrobat = True 'Report goes to
..PDF file using report's .Caption name as file name
' .PrintReport 'and Acrobat is
opened to show report.
' If .ErrorCount > 0 Then
' MsgBox .ErrorList, vbCritical, "Print Failed"
' End If
'
' .PrinterName = "\\NtPrt41\Invs tPrt"
' .Copies = 2
' .Orientation = rpOrient_Landsc ape
' .PrintReport 'Two copies of
report go to specified printer in landscape orientation.
' If .ErrorCount > 0 Then
' MsgBox .ErrorList, vbCritical, "Print Failed"
' End If
'
' .ReportName = "rptVanguardTim eSheet" 'As above, two
copies go to specified printer in landscape orientation
' .PrintReport 'because .Copies,
..PrinterName, and .Orientation are still set.
' End With
'
' On Error Resume Next
' Set myReportPrinter = Nothing
' Exit Sub
' End Sub
'
=============== =============== =============== =============== =========
'
' Pete Cresswell
' 03/22/2001
' 610-513-0066
Private Const mPdfPrinterName = "Acrobat PDFWriter" 'SB exactly the same as
name that shows up in "myComputer/Printers"

Private Const adhcMaxDevice = 32
Private Const adhcDevNamesFix ed = 8
Private Const adhcFixedChars = adhcDevNamesFix ed / 2

Private Const mDriverStringLe nBinName = 24
Private Const mDriverStringLe nPaperName = 64
Private Const mDriverStringLe nBinDependency = 64

Private Const mFormNameLen = 32
Private Const mPrinterNameLen = 32

'Private Const mCallStackLim = 50
Private Const mCallStackLim = 150
Private mCallStack(mCal lStackLim)
Private mCallStackPoint er As Integer

Private Const mErrorListMessa gePrefix = "- "
Private Const mDevModeFudgeFa ctor = 2048
Private Const mDevModeSize = 148
Private Const mDevModeSizeLim = mDevModeSize + mDevModeFudgeFa ctor

Private Type mPrinterStruct
IsDefaultPrinte r As Boolean
DeviceName As String
DriverName As String
Port As String
End Type

Private Type mPrtDevModeStru ct
strDeviceName(1 To mPrinterNameLen ) As Byte
intSpecVersion As Integer
intDriverVersio n As Integer
intSize As Integer
intDriverExtra As Integer
lngFields As Long
intOrientation As Integer
intPaperSize As Integer
intPaperLength As Integer
intPaperWidth As Integer
intScale As Integer
intCopies As Integer
intDefaultSourc e As Integer
intPrintQuality As Integer
intColor As Integer
intDuplex As Integer
intYResolution As Integer
intTTOption As Integer
intCollate As Integer

strFormName(1 To mFormNameLen) As Byte
intLogPixels As Integer
lngBitsPerPixel As Long
lngPelsWidth As Long
lngPelsHeight As Long
lngDisplayFlags As Long
lngDisplayFrequ ency As Long
lngICMMethod As Long
lngICMIntent As Long
lngMediaType As Long
lngDitherType As Long
lngReserved1 As Long
lngReserved2 As Long
bytDriverExtra( 1 To mDevModeFudgeFa ctor) As Byte
End Type

Private Type mDevModeStringS truct
strDevMode As String * mDevModeSizeLim
End Type

Private Type mDevNamesOffset InfoStruct
DriverOffset As Integer
DeviceOffset As Integer
OutputOffset As Integer
IsDefaultPrinte r As Integer
End Type

Private Type mDevNamesOffset StringStruct
strDevInfo As String * adhcFixedChars
End Type

Private Type mDoubleWordStru ct
Value As Long
End Type

Private Type mSplitWordStruc t
LoWord As Integer
HiWord As Integer
End Type

Private Type mXyPoint
x As Long
Y As Long
End Type
Public Enum rpDmBitFields ' Constants for Bitfields for the
Fields member of the DevMode structure.
rp_Color = &H800
rp_Collate = &H8000
rp_Copies = &H100
rp_DefaultSourc e = &H200
rp_Duplex = &H1000
rp_Orientation = &H1
rp_PaperLength = &H4
rp_PaperSize = &H2
rp_PaperWidth = &H8
rp_PrintQuality = &H400
rp_Scale = &H10
rp_Y_Resolution = &H2000
' rp_T_Option = &H4000
End Enum

'Private Enum dmTrueType
' DMTT_BITMAP = 1
' DMTT_DOWNLOAD = 2
' DMTT_SUBDEV = 4
' DMTT_DOWNLOAD_O UTLINE = 8
'End Enum
'Private mlngTT As dmTrueType

Public Enum rpCollate ' Constants for Collate property
rpCollate_True = 1
rpCollate_False = 0
End Enum

Public Enum rpColor ' Constants for Color property
rpColor_Monochr ome = 1
rpColor_Color = 2
End Enum

Public Enum rpDefaultSource ' Constants for DefaultSource
property
rpSrc_Upper = 1
rpSrc_OnlyOne = 1
rpSrc_Lower = 2
rpSrc_Middle = 3
rpSrc_Manual_Fe ed = 4
rpSrc_Envelope = 5
rpSrc_Envelope_ Manual_Feed = 6
rpSrc_Auto = 7
rpSrc_Tractor = 8
rpSrc_Small_For mat = 9
rpSrc_Large_For mat = 10
rpSrc_Large_Cap acity = 11
rpSrc_Cassette = 14
rpSrc_Form_Sour ce = 15
rpSrc_User = 256
End Enum

Public Enum rpDuplex ' Constants for Duplex property
rpDuplex_Simple x = 1
rpDuplex_Vertic al = 2
rpDuplex_Horizo ntal = 3
End Enum

Public Enum rpGetPdfFileNam eFrom
rpGetFromReport Name = 1
rpGetFromReport Caption = 2
End Enum

Public Enum rpOrientation ' Constants for Orientation
property
rporient_Portra it = 1
rporient_landsc ape = 2
End Enum

Public Enum rpPaperSize ' Constants for PaperSize property
rpPaper_Letter = 1 ' Letter 8 1/2 x 11
rpPaper_LetterS mall = 2 ' Letter Small 8 1/2 x 11
rpPaper_Tabloid = 3 ' Tabloid 11 x 17
rpPaper_Ledger = 4 ' Ledger 17 x 11
rpPaper_Legal = 5 ' Legal 8 1/2 x 14
rpPaper_Stateme nt = 6 ' Statement 5 1/2 x 8 1/2
rpPaper_Executi ve = 7 ' Executive 7 1/4 x 10 1/2
rpPAPER_A3 = 8 ' A3 297 x 420 mm
rpPaper_A4 = 9 ' A4 210 x 297 mm
rpPaper_A4_Smal l = 10 ' A4 Small 210 x 297 mm
rpPaper_A5 = 11 ' A5 148 x 210 mm
rpPaper_B4 = 12 ' B4 (JIS) 250 x 354 mm
rpPaper_B5 = 13 ' B5 (JIS) 182 x 257 mm
rpPaper_FOLIO = 14 ' Folio 8 1/2 x 13
rpPaper_QUARTO = 15 ' Quarto 215 x 275 mm
rpPaper_10X14 = 16 ' 10x14 in
rpPaper_11X17 = 17 ' 11x17 in
rpPaper_NOTE = 18 ' Note 8 1/2 x 11 in
rpPaper_Env_9 = 19 ' Envelope #9 3 7/8 x 8 7/8
rpPaper_Env_10 = 20 ' Envelope #10 4 1/8 x 9 1/2
rpPaper_Env_11 = 21 ' Envelope #11 4 1/2 x 10 3/8
rpPaper_Env_12 = 22 ' Envelope #12 4 \276 x 11
rpPaper_Env_14 = 23 ' Envelope #14 5 x 11 1/2
rpPaper_C_Sheet = 24 ' C size sheet
rpPaper_D_Sheet = 25 ' D size sheet
rpPaper_E_Sheet = 26 ' E size sheet
rpPaper_Env_DL = 27 ' Envelope DL 110 x 220mm
rpPaper_Env_C5 = 28 ' Envelope C5 162 x 229 mm
rpPaper_Env_C3 = 29 ' Envelope C3 324 x 458 mm
rpPaper_Env_C4 = 30 ' Envelope C4 229 x 324 mm
rpPaper_Env_C6 = 31 ' Envelope C6 114 x 162 mm
rpPaper_Env_C65 = 32 ' Envelope C65 114 x 229 mm
rpPaper_Env_B4 = 33 ' Envelope B4 250 x 353 mm
rpPaper_Env_B5 = 34 ' Envelope B5 176 x 250 mm
rpPaper_Env_B6 = 35 ' Envelope B6 176 x 125 mm
rpPaper_Env_ITA LY = 36 ' Envelope 110 x 230 mm
rpPaper_Env_Mon arch = 37 ' Envelope Monarch 3.875 x 7.5
rpPaper_Env_Per sonal = 38 ' Envelope 3 5/8 x 6 1/2
rpPaper_FanFold _US = 39 ' US Std Fanfold 14 7/8 x 11
rpPaper_FanFold _Std_German = 40 ' German Std Fanfold 8 1/2 x 12
rpPaper_FanFold _Lgl_German = 41 ' German Legal Fanfold 8 1/2 x 13
rpPaper_ISO_B4 = 42 ' B4 (ISO) 250 x 353 mm
rpPaper_Japanes e_Postcard = 43 ' Japanese Postcard 100 x 148 mm
rpPaper_9X11 = 44 ' 9 x 11
rpPaper_10X11 = 45 ' 10 x 11
rpPaper_15X11 = 46 ' 15 x 11
rpPaper_Env_Inv ite = 47 ' Envelope Invite 220 x 220 mm
rpPaper_Reserve d_48 = 48 ' RESERVED--DO NOT USE
rpPaper_Reserve d_49 = 49 ' RESERVED--DO NOT USE
rpPaper_Letter_ Extra = 50 ' Letter Extra 9 x 12
rpPaper_LEGAL_E xtra = 51 ' Legal Extra 9 x 15
rpPaper_Tabloid _Extra = 52 ' Tabloid Extra 11.69 x 18
rpPaper_A4_Extr a = 53 ' A4 Extra 9.27 x 12.69
rpPaper_Letter_ Transverse = 54 ' Letter Transverse 8 \275 x 11
rpPaper_A4_Tran sverse = 55 ' A4 Transverse 210 x 297 mm
rpPaper_Letter_ Extra_Transvers e = 56 ' Letter Extra Transverse 9\275 x
12
rpPaper_A_Plus = 57 ' SuperA/SuperA/A4 227 x 356 mm
rpPaper_B_Plus = 58 ' SuperB/SuperB/A3 305 x 487 mm
rpPaper_Letter_ Plus = 59 ' Letter Plus 8.5 x 12.69
rpPaper_A4_Plus = 60 ' A4 Plus 210 x 330 mm
rpPaper_A5_Tran sverse = 61 ' A5 Transverse 148 x 210 mm
rpPaper_B5_Tran sverse = 62 ' B5 (JIS) Transverse 182 x 257 mm
rpPaper_A3_Extr a = 63 ' A3 Extra 322 x 445 mm
rpPaper_A5_Extr a = 64 ' A5 Extra 174 x 235 mm
rpPaper_B5_Extr a = 65 ' B5 (ISO) Extra 201 x 276 mm
rpPaper_A2 = 66 ' A2 420 x 594 mm
rpPaper_A3_Tran sverse = 67 ' A3 Transverse 297 x 420 mm
rpPaper_A3_Extr a_Transverse = 68 ' A3 Extra Transverse 322 x 445 mm
rpPaper_User = 256 ' ?????
End Enum

Public Enum rpPrintQuality ' Constants for PrintQuality property
rpQual_Draft = -1
rpQual_Low = -2
rpQual_Medium = -3
rpQual_High = -4
End Enum

'Public Enum rpTrueType
' rpTT_BitMap = 1
' rpTT_DownLoad = 2
' rpTT_DubDev = 3
' rpTT_DownLoad_O utline = 4
'End Enum

Private mCurView As Integer
Private mCurPdfDir As String
Private mCurFilter As String
Private mCurDevMode As mPrtDevModeStru ct
Private mCurErrorList As String
Private mCurPrinters() As mPrinterStruct 'The class's list of all
printers installed on this PC
Private mCurErrorCount As Long
Private mCurReportName As String
Private mCurPrinterName As String
Private mCurErrorLogPat h As String
Private mCurLaunchAcrob at As Boolean
Private mCurGetPdfFileN ameFrom As Long
Private mCurShowPdfRegi stryInfo As Boolean
Private mCurReportFileN amePrefix As String
Private mCurReportFileN ameSuffix As String

Public Enum rpView
rpViewNormal = acViewNormal
rpViewPreview = acViewPreview
End Enum

Private Declare Function ClosePrinter Lib "winspool.d rv" (ByVal hPrinter As
Long) As Long
Private Declare Function DocumentPropert ies Lib "winspool.d rv" Alias
"DocumentProper tiesA" (ByVal hwnd As Long, ByVal hPrinter As Long, ByVal
pDeviceName As String, pDevModeOutput As Byte, pDevModeInput As Byte, ByVal
fMode As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNam eA"
(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetProfileSecti on Lib "kernel32" Alias
"GetProfileSect ionA" (ByVal lpAppName As String, ByVal lpReturnedStrin g As
String, ByVal lngSize As Long) As Long
Private Declare Function GetProfileStrin g Lib "kernel32" Alias
"GetProfileStri ngA" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal
lpDefault As String, ByVal lpReturnedStrin g As String, ByVal nSize As Long) As
Long
Private Declare Function GetUserName Lib "advapi32.d ll" Alias "GetUserNam eA"
(ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function OpenPrinter Lib "winspool.d rv" Alias "OpenPrinte rA"
(ByVal pPrinterName As String, phPrinter As Long, ByVal pDefault As Long) As
Long

Private Declare Function DeviceCapabilit iesAny Lib "winspool.d rv" Alias
"DeviceCapabili tiesA" (ByVal strDeviceName As String, ByVal strPort As String,
ByVal lngIndex As Long, lpOutput As Any, ByVal lngDevMode As Long) As Long
Private Declare Function DeviceCapabilit iesLng Lib "winspool.d rv" Alias
"DeviceCapabili tiesA" (ByVal strDeviceName As String, ByVal strPort As String,
ByVal lngIndex As Long, ByVal lngOutput As Long, ByVal lngDevMode As Long) As
Long
Private Declare Function DeviceCapabilit iesStr Lib "winspool.d rv" Alias
"DeviceCapabili tiesA" (ByVal strDeviceName As String, ByVal strPort As String,
ByVal lngIndex As Long, ByVal strOutput As String, ByVal lngDevMode As Long) As
Long

Private Enum mDeviceCapabili tyTypes ' Constants for Device Capabilities
dcFields = 1
dcPapers = 2
dcPapersize = 3
dcMinExtent = 4
dcMaxExtent = 5
dcBins = 6
dcDuplex = 7
dcSize = 8
dcExtra = 9
dcVersion = 10
dcDriver = 11
dcBinNames = 12
dcEnumResolutio ns = 13
dcFileDependenc ies = 14
dcTrueType = 15
dcPaperNames = 16
dcOrientation = 17
dcCopies = 18
End Enum

Private Declare Function RegCloseKey Lib "advapi32.d ll" (ByVal lngHKey As Long)
As Long
Private Declare Function RegCreateKeyEx Lib "advapi32.d ll" Alias
"RegCreateKeyEx A" (ByVal lngHKey As Long, ByVal lpSubKey As String, ByVal
Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal
samDesired As Long, ByVal lpSecurityAttri butes As Long, phkResult As Long,
lpdwDisposition As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.d ll" Alias "RegOpenKey ExA"
(ByVal lngHKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal
samDesired As Long, phkResult As Long) As Long
Private Declare Function RegQueryValueEx A Lib "advapi32.d ll" (ByVal lngHKey As
Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long,
ByVal lpData As Long, lpcbData As Long) As Long
Private Declare Function RegQueryValueEx Long Lib "advapi32.d ll" Alias
"RegQueryValueE xA" (ByVal lngHKey As Long, ByVal lpValueName As String, ByVal
lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Private Declare Function RegQueryValueEx String Lib "advapi32.d ll" Alias
"RegQueryValueE xA" (ByVal lngHKey As Long, ByVal lpValueName As String, ByVal
lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As
Long
Private Declare Function RegSetValueExLo ng Lib "advapi32.d ll" Alias
"RegSetValueExA " (ByVal lngHKey As Long, ByVal lpValueName As String, ByVal
Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long)
As Long
Private Declare Function RegSetValueExSt ring Lib "advapi32.d ll" Alias
"RegSetValueExA " (ByVal lngHKey As Long, ByVal lpValueName As String, ByVal
Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As
Long) As Long

'Private Const mRegHKeyClasses Root = &H80000000
'Private Const mRegHKeyLocalMa chine = &H80000002
Private Const mRegHKeyCurrent User = &H80000001
Private Const mPdfWriterKeyNa me = "Software\Adobe \Acrobat PDFWriter"

Private Const mRegOptionNonVo latile = 0
Private Const mRregKeyAllAcce ss = &H3F
Private Const mRegSz As Long = 1
Private Const mRegDWord As Long = 4
Private Const mRegKeyQueryVal ue = &H1
'

Private Sub Class_Initializ e()
callStackPush mModuleName, "Class_Initiali ze"
On Error GoTo catchError

' PURPOSE: - To populate the class's collection of all printers on this PC
' - To make sure we have at least one printer installed
' - To set any default values for properties
'
' NOTES: 1) The assumption is that if there is no default printer, no printers
are installed.

printerArrayLoa d

mCurView = rpViewNormal
mCurPdfDir = extractDirFromF ullPath(Applica tion.CurrentDb. Name)
mCurPrinterName = printerDefaultG et.DeviceName
mCurGetPdfFileN ameFrom = rpGetFromReport Caption

If Len(mCurPrinter Name) = 0 Then
errorListAdd "No printer is installed on this PC. Cannot print until at
least one printer is installed."
Else
With mCurDevMode
.intCollate = rpCollate_False
.intCopies = 1
.intColor = rpColor_Monochr ome
.intDefaultSour ce = rpSrc_Auto
.intDuplex = rpDuplex_Simple x
.intOrientation = rporient_Portra it
.intPaperSize = rpPaper_Letter
.intPrintQualit y = rpQual_High
End With
End If

Xit:
callStackPop
On Error Resume Next
Exit Sub

catchError:
errorLogWrite ""
Resume Xit
End Sub
Public Property Get ErrorCount() As Long
callStackPush mModuleName, "ErrorCount "
On Error GoTo catchError

' PURPOSE: - To allow the using routine to check for errors.
' RETURNS: Count of errors

ErrorCount = mCurErrorCount

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property
Public Property Get ErrorList() As String
callStackPush mModuleName, "ErrorList"
On Error GoTo catchError

' PURPOSE: - To allow the using routine to display error messages
' RETURNS: Error messages

ErrorList = mCurErrorList

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Property
Public Property Let GetPdfFileNameF rom(ByVal theValue As rpGetPdfFileNam eFrom)
callStackPush mModuleName, "GetPdfFileName From"
On Error GoTo catchError

' PURPOSE: To allow the calling routine to specify whether to use
' report's .Caption or object name when creating PDF file name.

mCurGetPdfFileN ameFrom = theValue

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property
Public Property Let ReportName(ByVa l theValue As String)
callStackPush mModuleName, "ReportName "
On Error GoTo catchError

' PURPOSE: - To allow the using routine to set the name of the report to be
printed
' ACCEPTS: Name of the Report

mCurReportName = theValue

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property
Public Property Let PdfDir(ByRef theValue As String)
callStackPush mModuleName, "PdfDir"
On Error GoTo catchError

' PURPOSE: - To allow the using routine to set the class' PDF directory
' ACCEPTS: String specifying full path to which any .PDF file should be
' written. Does *not* contain file name. e.g. C:\TEMP

mCurPdfDir = theValue

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property
Public Property Let ReportFileNameP refix(ByRef theValue As String)
callStackPush mModuleName, "ReportFileName Prefix"
On Error GoTo catchError

' PURPOSE: - To allow the using routine to supply a string to be appended before
' each report's PDF file name
' ACCEPTS: String specifying the prefix

mCurReportFileN amePrefix = theValue

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property
Public Property Let ReportFileNameS uffix(ByRef theValue As String)
callStackPush mModuleName, "ReportFileName Suffix"
On Error GoTo catchError

' PURPOSE: - To allow the using routine to supply a string to be appended after
' each report's PDF file name
' ACCEPTS: String specifying the suffix

mCurReportFileN ameSuffix = theValue

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property
Public Property Let PrinterName(ByR ef theValue As String)
callStackPush mModuleName, "PrinterNam e"
On Error GoTo catchError

' PURPOSE: - To allow the using routine to set the class' Printer object
' ACCEPTS: String specifying UNC of printer. e.g. \\NTPRT41\INVHP 5SI

mCurPrinterName = theValue

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property
Public Sub PrintReport()
6000 callStackPush mModuleName, "PrintRepor t"
6001 On Error GoTo catchError

' PURPOSE: - To allow the using routine to print the report
' - To validate all propreties before attempting to print
' SETS: - mCurErrorCount (via 'errorListAdd')
' - mCurErrorList (via 'errorListAdd')
'
' NOTES: 1) We validate parameters in three places, using mCurErrorCount to
' check after each validation:
' - In this routine
' - In validatePrinter PropsAndCapabil ities()
' - In pdfRegistrySet( )
' 2) There are no "Warning" errors. Every error is fatal.
' We do not print unless there are zero errors.
' 3) We keep checking mCurErrorCount because once certain errors
occur,
' we do not want to keep checking. e.g. Not having any printer
installed
' on the PC would pretty much defeat the rest of the checking.
' 4) BEWARE of the .ECHO situation.
' You will need to rem out the DoCmd.Echo False when debugging.
We use
' it when opening the report in 'Design' mode prior to modifying
it's
' print characteristics . .Echo False is not essential to run,
but
' True causes unsightly screen flickering.
'
6002 Dim myReport As Report
Dim myPrinter As mPrinterStruct
Dim myDevModeStruct As mPrtDevModeStru ct
Dim myByteArray() As Byte

Dim myGotPdf As Boolean
Dim myPdfFileName As String
Dim myPdfRegistryIn fo As String

Const noSuchReport = 2103

6010 If Len(mCurErrorLo gPath) > 0 Then 'This should never happen because we
default the path to application's directory
6011 If validateErrorFi lePath(mCurErro rLogPath) = False Then
6012 errorListAdd ".ErrorLogP ath: Unable to create the error log file
using path specified. Could one or more of the path's directories be missing?
Path specified = '" & mCurErrorLogPat h & "'."
6013 End If
6019 End If

6020 If Len(mCurPrinter Name) > 0 Then
6021 myPrinter = printerGet(mCur PrinterName)
6022 If Len(myPrinter.D eviceName) & "" = 0 Then
6023 errorListAdd ".PrinterNa me: Printer '" & mCurPrinterName & "' is not
installed on this PC.'"
6024 Else
6025 validatePrinter PropsAndCapabil ities myPrinter
6026 End If
6029 Else 'we probably shouldn't get this far
with no printer name, but might as well CYA...
6030 errorListAdd ".PrinterNa me: Blank printer name specified. If you
specify a printer name, it must be the name of a printer installed on this PC."
6039 End If

6040 If mCurErrorCount = 0 Then
6041 If Len(mCurReportN ame) = 0 Then
6042 errorListAdd ".ReportNam e: PROGRAM ERROR. No report name found."
6043 errorLogWrite "No report name found. We should not have gotten this
far with this condition present."
6044 Else
6045 On Error Resume Next
6046 With DoCmd
6047 .Close acReport, mCurReportName, acSaveNo
6048 .Echo False
6049 .OpenReport mCurReportName, acViewDesign
6050 End With

6200 Select Case Err
Case 0
6202 Set myReport = Reports(mCurRep ortName)
6203 If Len(mCurFilter & "") > 0 Then
6204 With myReport
6205 .Filter = mCurFilter
6206 .FilterOn = True
6207 End With
6208 End If
6209 Case noSuchReport
6210 errorListAdd ".ReportNam e: There is no such report as '" &
mCurReportName & " in this MS Access DB'."
6211 Case Else
6212 errorLogWrite ""
6213 End Select
6214 End If
6219 End If

6230 Select Case mCurView
Case acViewNormal, acViewPreview
'(a-ok, do nothing)
6232 Case Else
6233 errorListAdd ".View: Value passed = " & Format$(mCurVie w & "", "#") &
". Values allowed are: " & Format$(acViewN ormal, "#") & " = Normal, " &
Format$(acViewP review, "#") & " = Preview"
6239 End Select

' -----------------------------------
' Get the specified printer's PrtDevMode,
' modify it in accordance with properties specified by caller,
' and then copy it over the report's PrtDevMode

6410 If mCurErrorCount = 0 Then
6411 myDevModeStruct = printerDevModeG et(mCurPrinterN ame)
6412 With myDevModeStruct
6413 .intCollate = mCurDevMode.int Collate
6414 .intColor = mCurDevMode.int Color
6415 .intCopies = mCurDevMode.int Copies
6416 .intDuplex = mCurDevMode.int Duplex
6417 .intOrientation = mCurDevMode.int Orientation
6418 .intPaperLength = mCurDevMode.int PaperLength
6419 .intPaperSize = mCurDevMode.int PaperSize
6430 .intPaperWidth = mCurDevMode.int PaperWidth
6431 .intPrintQualit y = mCurDevMode.int PrintQuality
6432 .intScale = mCurDevMode.int Scale
6433 .intTTOption = mCurDevMode.int TTOption
6434 .intYResolution = mCurDevMode.int YResolution
6435 .lngFields = mCurDevMode.lng Fields
6436 End With
6437 myByteArray = devModeToBytes( myDevModeStruct )
6438 myReport.PrtDev Mode = myByteArray
6499 End If

' -----------------------------------
' Create a PrtDevNames struct that looks the same
' as the printer's and then overlay the report's
' with it

6600 If mCurErrorCount = 0 Then
6601 myByteArray = devNamesInfoBui ldForPrinter(my Printer)
6602 myReport.PrtDev Names = myByteArray
6609 End If

' -----------------------------------
' If we are sending to .PDF, generate file name and set registry

6800 If mCurErrorCount = 0 Then
6801 If Left(myPrinter. DeviceName, Len(mCurPrinter Name)) = mPdfPrinterName
Then
6802 myGotPdf = True
6803 If Not pdfWriterInstal led() Then
6804 errorListAdd "PDF Writer Not Installed: 'Acrobat PDF Writer' print
driver not found on this PC. Just the reader or a LAN connection to another
PC's writer is not enough. This PC must have a full Acrobat install including
PDF Writer."
6805 Else
6806 If Len(mCurPdfDir) & "" = 0 Then
6807 errorListAdd ".PdfDir: When printing to PDF Writer, you must
specify an existing directory into which the .PDF files will be written. e.g.
..PdfDir='C:\TE MP'."
6808 Else
6809 If dirExist(mCurPd fDir) = False Then
6820 errorListAdd ".PdfDir: Directory '" & mCurPdfDir & "' not
found. Create it or specify a different directory. Be sure to specify ONLY a
directory, NOT including a file name. File name(s) will be created from
report's object name or .Caption."
6821 Else
6822 myPdfFileName = pdfFileNameCrea te(mCurGetPdfFi leNameFrom,
mCurReportFileN amePrefix, mCurReportFileN ameSuffix, myReport)
6823 If mCurErrorCount = 0 Then
6824 If mCurShowPdfRegi stryInfo = True Then
6825 myPdfRegistryIn fo = String(40, "-") & vbCrLf & "Before
Setting Registry:" & vbCrLf & Space(15) & pdfRegistryGet( )
6826 End If
6827 If pdfRegistrySet( myPdfFileName, mCurPdfDir) Then
6828 If mCurShowPdfRegi stryInfo = True Then
6829 myPdfRegistryIn fo = myPdfRegistryIn fo & vbCrLf &
vbCrLf & String(40, "-") & vbCrLf & "After Setting Registry, But Before
Printing:" & vbCrLf & Space(15) & pdfRegistryGet( )
6840 End If
6841 Else
6842 errorListAdd "Registry Permission Problem? Unable to
set registry entries for Adobe Acrobat PDF"
6843 End If
6844 End If
6845 End If
6846 End If
6847 End If
6848 End If
6899 End If

' -----------------------------------
' Print the report

6900 If mCurErrorCount = 0 Then
6901 If mCurView = acViewPreview Then 'Abandon everything
we've done to the report so far, and just open it fresh in preview mode
6902 With DoCmd
6903 .Close acReport, mCurReportName, acSaveNo
6904 .Echo True
6905 .SetWarnings True
6906 .OpenReport mCurReportName, acPreview, , mCurFilter
6907 End With
6908 Else
6909 With DoCmd
6910 .OpenReport mCurReportName, mCurView, , mCurFilter 'Filter was
set back when we opened it in Design mode
6911 .Echo True
6912 .Close acReport, mCurReportName, acSaveNo
6913 .SetWarnings True
6914 End With
6915 If myGotPdf = True Then
6916 If mCurShowPdfRegi stryInfo = True Then
6917 myPdfRegistryIn fo = myPdfRegistryIn fo & vbCrLf & String(40,
"-") & vbCrLf & "After Printing:" & Space(5) & pdfRegistryGet( )
6918 MsgBox myPdfRegistryIn fo, vbInformation, "PDF-Related Registry
Settings"
6919 End If
6920 End If
6921 End If
6999 End If

Xit:
callStackPop
On Error Resume Next
With DoCmd
If mCurView <> acViewPreview Then
.Close acReport, mCurReportName, acSaveNo
End If
.Echo True
.SetWarnings True
End With
Set myReport = Nothing
Exit Sub

catchError:
With DoCmd
.Echo True
.SetWarnings True
End With
errorLogWrite ""
Resume Xit
End Sub
Public Property Let Collate(theValu e As rpCollate)
callStackPush mModuleName, "Collate"
On Error GoTo catchError

mCurDevMode.int Collate = theValue
mCurDevMode.lng Fields = mCurDevMode.lng Fields Or rp_Collate

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property
Public Property Let Color(theValue As rpColor)
callStackPush mModuleName, "Color"
On Error GoTo catchError

mCurDevMode.int Color = theValue
mCurDevMode.lng Fields = mCurDevMode.lng Fields Or rp_Color

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property
Public Property Let Copies(theValue As Integer)
callStackPush mModuleName, "Copies"
On Error GoTo catchError

mCurDevMode.int Copies = theValue
mCurDevMode.lng Fields = mCurDevMode.lng Fields Or rp_Copies

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property
Public Property Let DefaultSource(t heValue As rpDefaultSource )
callStackPush mModuleName, "DefaultSou rce"
On Error GoTo catchError

mCurDevMode.int DefaultSource = theValue
mCurDevMode.lng Fields = mCurDevMode.lng Fields Or rp_DefaultSourc e

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property
Public Property Let Duplex(theValue As rpDuplex)
callStackPush mModuleName, "Duplex"
On Error GoTo catchError

mCurDevMode.int Duplex = theValue
mCurDevMode.lng Fields = mCurDevMode.lng Fields Or rp_Duplex

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property
Public Property Let ErrorLogPath(By Val theValue As String)
callStackPush mModuleName, "ErrorLogPa th"
On Error GoTo catchError

mCurErrorLogPat h = theValue

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property
Public Property Let Filter(theValue As String)
callStackPush mModuleName, "Filter"
On Error GoTo catchError

mCurFilter = theValue

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property
Public Property Let LaunchAcrobat(t heValue As Boolean)
callStackPush mModuleName, "LaunchAcro bat"
On Error GoTo catchError

mCurLaunchAcrob at = theValue

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property
Public Property Let Orientation(the Value As rpOrientation)
callStackPush mModuleName, "Orientatio n"
On Error GoTo catchError

mCurDevMode.int Orientation = theValue
mCurDevMode.lng Fields = mCurDevMode.lng Fields Or rp_Orientation

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property

'Public Property Let PaperLength(the Value As Integer)
' mCurDevMode.int PaperLength = theValue
' mCurDevMode.lng Fields = mCurDevMode.lng Fields Or rp_PaperLength
'End Property

Public Property Let PaperSize(theVa lue As rpPaperSize)
callStackPush mModuleName, "PaperSize"
On Error GoTo catchError

mCurDevMode.int PaperSize = theValue
mCurDevMode.lng Fields = mCurDevMode.lng Fields Or rp_PaperSize

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property

'Public Property Let PaperWidth(theV alue As Integer)
' mCurDevMode.int PaperWidth = theValue
' mCurDevMode.lng Fields = mCurDevMode.lng Fields Or rp_PaperWidth
'End Property

Public Property Let PrintQuality(th eValue As rpPrintQuality)
callStackPush mModuleName, "PrintQuali ty"
On Error GoTo catchError

mCurDevMode.int PrintQuality = theValue
mCurDevMode.lng Fields = mCurDevMode.lng Fields Or rp_PrintQuality

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property

'Public Property Let ScaleAmount(the Value As Integer)
' mCurDevMode.int Scale = theValue
' mCurDevMode.lng Fields = mCurDevMode.lng Fields Or rp_Scale
'End Property

Public Property Let ShowPdfRegistry Info(theValue As Boolean)
callStackPush mModuleName, "ShowPdfRegistr yInfo"
On Error GoTo catchError

mCurShowPdfRegi stryInfo = theValue

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property

'Public Property Let TrueTypeOption( theValue As rpTrueType)
' callStackPush mModuleName, "TrueTypeOption "
' On Error GoTo catchError
'
' mCurDevMode.int TTOption = theValue
' mCurDevMode.lng Fields = mCurDevMode.lng Fields Or rp_T_Option
'
'Xit:
' callStackPop
' On Error Resume Next
' Exit Property
'
'catchError:
' errorLogWrite ""
' Resume Xit
'End Property

Public Property Let View(theValue As rpView)
callStackPush mModuleName, "View"
On Error GoTo catchError

mCurView = theValue

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property
Public Property Let YResolution(the Value As Integer)
callStackPush mModuleName, "YResolutio n"
On Error GoTo catchError

mCurDevMode.int YResolution = theValue
mCurDevMode.lng Fields = mCurDevMode.lng Fields Or rp_Y_Resolution

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property
Public Function legalFileName(B yVal theName As String) As String
callStackPush mModuleName, "legalFileN ame"
On Error GoTo catchError

' PURPOSE: To convert a string into something that can function as
' part of a DOS file name
' ACCEPTS: The string to be converted
' RETURNS: A string with any illegal characters replaced with underscores
'
' NOTES: 1) We originally decided which chars to replace by trying to
' rename a file to something containing "?"(which we knew was
' illegal) and then noting the other illegal chars described
' in the error message.

Dim badBoyz() As Variant

Dim L As Long
Dim i As Integer
Dim isDone As Boolean
Dim myName As String
Dim arraySize As Integer

Const underScore = "_"

myName = theName
badBoyz = Array("/", "\", ":", "*", "?", Chr$(34), "<", ">", "|")
arraySize = UBound(badBoyz)

For i = 0 To arraySize
isDone = False
Do Until isDone = True
L = InStr(1, myName, badBoyz(i))
If L = 0 Then
isDone = True
Else
Mid$(myName, L, 1) = underScore
End If
Loop
Next i

legalFileName = myName

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Function
Private Function pdfWriterInstal led() As Boolean
callStackPush mModuleName, "pdfWriterInsta lled"
On Error GoTo catchError

' PURPOSE: To determine whether-or-not the Adobe Acrobat PDFWriter
' is installed on an NT 4.0 or later machine.
'
' RETURNS: True if installed, False if not

Dim hPrinter As Long

If OpenPrinter(mPd fPrinterName, hPrinter, 0) Then
ClosePrinter (hPrinter)
pdfWriterInstal led = True
End If

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Function
Public Function dirExist(ByVal theDirPath As Variant) As String
callStackPush mModuleName, "dirExist"
On Error GoTo catchError

' PURPOSE: To determine whether-or-not a directory exists
' ACCEPTS: A path to the directory in question
' RETURNS: Empty string if directory exists, else a message telling why not
found.

Dim skipLine As String

dirExist = (Dir$(theDirPat h, vbDirectory) <> "")

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
Select Case Err
Case 71
MsgBox "That path refers to a floppy disk. Please insert the disk.", 49,
"Insert Disk"

Case 76
'(We expect 76 if no file found)

Case 68
errorListAdd "Bad Directory. The system has reported that drive " &
UCase$(Left$(th eDirPath, 2)) & " is unavailable."

Case Else
errorLogWrite "Unexpected case"
End Select

Resume Xit
End Function
Private Sub errorListAdd(By Val theMessage As String)
On Error GoTo catchError

' PURPOSE: To add an error to mCurErrorList and increment the error count
' ACCEPTS: The error message to add
'
' NOTES: 1) Limited error trapping because we are already in an error
' situation and want to avoid any chance of a loop

mCurErrorCount = mCurErrorCount + 1

If Len(mCurErrorLi st) = 0 Then
mCurErrorList = "clsReportPrint er, version " & mVersionNumber & vbCrLf &
vbCrLf & mErrorListMessa gePrefix & theMessage
Else
mCurErrorList = mCurErrorList & vbCrLf & mErrorListMessa gePrefix &
theMessage
End If

Xit:
On Error Resume Next
Exit Sub

catchError:
MsgBox "clsReportPrint er: runtime error in errorListAdd()"
Resume Xit
End Sub
Private Function printerDevModeG et(ByVal thePrinterName As String) As
mPrtDevModeStru ct
callStackPush mModuleName, "printerDevMode Get"
On Error GoTo catchError

' PURPOSE: To retrieve the PrtDevMode structure for the named printer
' ACCEPTS: Printer name (e.g. \\NTPRT41\INVHP 5SI)
' RETURNS: Printer's DevMode structure

Dim myDevModeStruct As mPrtDevModeStru ct
Dim myDevModeBytes( ) As Byte

Dim myDevModeLen As Long
Dim hPrinter As Long
Dim myDummyByte As Byte

Const myBufLen = 2

On Error GoTo catchError

If OpenPrinter(the PrinterName, hPrinter, 0) Then
If hPrinter > 0 Then
myDevModeLen = DocumentPropert ies(0, hPrinter, thePrinterName,
myDummyByte, myDummyByte, 0)
If myDevModeLen > 0 Then
ReDim myDevModeBytes( 1 To myDevModeLen)
If DocumentPropert ies(0, hPrinter, thePrinterName, myDevModeBytes( 1),
myDevModeBytes( 1), myBufLen) > 0 Then
myDevModeStruct = bytesToDevMode( myDevModeBytes)
printerDevModeG et = myDevModeStruct
End If
End If
End If
Call ClosePrinter(hP rinter)
End If

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Function
Private Function bytesToDevMode( ByRef theByteArray() As Byte) As
mPrtDevModeStru ct
callStackPush mModuleName, "bytesToDevMode "
On Error GoTo catchError

' PURPOSE: To convert an array of Byte into a PrtDevMode structure
' ACCEPTS: An array of Byte
' RETURNS: A DevMode structure containing same info as passed byte array

Dim myDevModeStruct As mPrtDevModeStru ct
Dim myDevModeString As mDevModeStringS truct

myDevModeString .strDevMode = theByteArray
LSet myDevModeStruct = myDevModeString
bytesToDevMode = myDevModeStruct

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Function
Private Function devModeToBytes( ByRef theDevMode As mPrtDevModeStru ct) As Byte()
callStackPush mModuleName, "devModeToBytes "
On Error GoTo catchError

' PURPOSE: To comvert a PrtDevMode structure into an array of Byte
' ACCEPTS: Pointer to the struct in question
' RETURNS: An array of Byte containing same info as in passed structure
'
' NOTES: 1) Apparently there can be some extra characters on the end of
' the intermediate string we create, hence the need to trim it
' via LeftB()

Dim myByteArray() As Byte
Dim myDevModeString As mDevModeStringS truct

LSet myDevModeString = theDevMode
myByteArray = LeftB(myDevMode String.strDevMo de, theDevMode.intS ize +
theDevMode.intD riverExtra)
devModeToBytes = myByteArray

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Function
Private Function uniToAnsi(strUn i As String) As Variant
callStackPush mModuleName, "uniToAnsi"
On Error GoTo catchError

' PURPOSE: To convert a Unicode string to ANSI.
' ACCEPTS: UniCode string
' RETURNS: ANSI string
'
' NOTES: 1)We must return a Variant, or VBA will convert
' it back to Unicode for you - just as a favor...

uniToAnsi = StrConv(strUni, vbFromUnicode)

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Function
Private Function devNamesInfoBui ldForPrinter(By Ref thePrinter As mPrinterStruct)
As Byte()
4000 callStackPush mModuleName, "devNamesInfoBu ildForPrinter"
4001 On Error GoTo catchError

' PURPOSE: Create a PrtDevNames structure for a given printer
' ACCEPTS: Structure containing information for the printer in question
' RETURNS: Byte array containing info needed to create a PrtDevNames
structure

4002 Dim myDNOI As mDevNamesOffset InfoStruct
Dim myOffsetString As mDevNamesOffset StringStruct
Dim myDefaultPrinte r As mPrinterStruct

Dim myBytes As Variant

' 4003 DoCmd.OpenRepor t ("Bogus") 'For use when debugging the error
handling routines

' ---------------------------------------------
' Check for maximum length for the device name
' (leaving room for the null terminator)

4011 If Len(thePrinter. DeviceName) > adhcMaxDevice - 1 Then
4012 thePrinter.Devi ceName = Left$(thePrinte r.DeviceName, adhcMaxDevice - 1)
4019 End If

' ---------------------------------------------
' The first offset is always offset 8

4020 With myDNOI
4021 .DriverOffset = adhcDevNamesFix ed
4022 .DeviceOffset = .DriverOffset + Len(thePrinter. DriverName) + 1
4023 .OutputOffset = .DeviceOffset + Len(thePrinter. DeviceName) + 1
4024 .IsDefaultPrint er = thePrinter.IsDe faultPrinter
4029 End With

' ---------------------------------------------
' If all the information in thePrinter matches the current
' default printer, then set Default to be 1.

4030 myDefaultPrinte r = printerDefaultG et
4031 With myDefaultPrinte r
4032 If (.DeviceName = thePrinter.Devi ceName) And (.DriverName =
thePrinter.Driv erName) And .Port = thePrinter.Port Then
4033 myDNOI.IsDefaul tPrinter = 1
4034 End If
4039 End With
' ---------------------------------------------

4041 LSet myOffsetString = myDNOI
4042 myBytes = myOffsetString. strDevInfo
4049 myBytes = myBytes & uniToAnsi(thePr inter.DriverNam e) & ChrB$(0) &
uniToAnsi(thePr inter.DeviceNam e) & ChrB$(0) & uniToAnsi(thePr inter.Port) &
ChrB$(0)

4999 devNamesInfoBui ldForPrinter = myBytes

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Function
Private Function regKeyValueSet( ByVal theRootKey As Long, ByVal theKeyName As
String, ByVal theValueName As String, ByVal theValueData As Variant, ByVal
theValueType As Long, ByRef theErrorMessage As String) As Boolean
callStackPush mModuleName, "regKeyValueSet "
On Error GoTo catchError

' ACCEPTS: - Root key value
' - Name of the key to open
' - Name of the value to open, vbNullString will open the default
value
' - Data to assign to the value
' - Data type of the value
' RETURNS: TRUE or FALSE depending on success
' SETS: - Error message in event of problem

Dim x As Long
Dim myKeyHandle As Long

x = RegCreateKeyEx( theRootKey, theKeyName, 0&, vbNullString,
mRegOptionNonVo latile, mRregKeyAllAcce ss, 0&, myKeyHandle, 0&)

If x <> 0 Then
theErrorMessage = "[ERROR: " & Str(x) & " returned by RegCreateKeyEx. "
Else
Select Case theValueType
Case mRegSz
x = RegSetValueExSt ring(myKeyHandl e, theValueName, 0&, theValueType,
theValueData, Len(theValueDat a))
If x <> 0 Then
theErrorMessage = "[ERROR: " & Str(x) & " returned by
RegSetValueExSt ring."
Else
regKeyValueSet = True
End If

Case mRegDWord
x = RegSetValueExLo ng(myKeyHandle, theValueName, 0&, theValueType,
theValueData, mRegDWord)
If x <> 0 Then
theErrorMessage = "[ERROR: " & Str(x) & " returned by
RegSetValueExLo ng."
Else
regKeyValueSet = True
End If
End Select
End If

Xit:
callStackPop
On Error Resume Next
RegCloseKey (myKeyHandle)
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Function
Private Function pdfRegistrySet( ByVal thePdfFileNameR aw As Variant, ByVal
theOutputDir As Variant) As Boolean
3000 callStackPush mModuleName, "pdfRegistrySet "
3001 On Error GoTo catchError

' PURPOSE: To set the registry values needed by PDFWriter to create a .PDF
file
' without issuing a common file dialog to the user.
' ACCEPTS: - Caption or MS Access object name of the report it is going to
create
' a .PDF file for
' - A path to the directory where the .PDF file will be wirtten.
' (Does *not* include file name. We develop that from the caption
or object name.)
' USES: mCurDevMode to get:
' - The paper size it should use (expressed as Enum rpPaperSize
' constants and then translated by this routine into Acrobat
constants)
' - The orientation on that paper )expressed as Enum rpOrientation
constants
' and translated....)
' - A pointer to the report in question, so we can set it's
..SpecificPrint er
' before turning PDFWriter loose on it.
'
' RETURNS: True or False depending on success
' SETS: Acrobat registry entries for
' - Paper size
' - Paper orientation
' - Path where .PDF will be written
'
' NOTES: 1) Windows PrdDevName constants for paper size and orientation
differ from
' Adobe's, so we have to translate them.
' 2) The calling routine is responsible for supplying a valid
existing
' directory path *WITHOUT* file name.
' 3) If a paper size that Adobe can't handle is passed, we just set
paper size
' to Tabloid since that's the biggest.
' 4) Ditto orientation...w e force LandScape if something besides
' portrait or landscape comes through

3002 Dim myOutputDir As String
Dim myPdfFileName As String
Dim myPdfFilePath As String

Dim myAcrobatPaperS ize As String
Dim myAcrobatOrient ation As String

Dim myValueName As String
Dim myValueData As String
Dim myErrorMessage As String

Const myDelim = ", "

3010 myValueName = "bExecViewe r"
3011 If (mCurLaunchAcro bat <> 0) And (mCurLaunchAcro bat <> -1) Then
3012 errorListAdd ".LaunchAcrobat : Values allowed: True (i.e. -1) or
False (i.e. 0). Value passed = " & Format$(mCurLau nchAcrobat & "", "0#") & ".
"
3013 Else
3014 If mCurLaunchAcrob at = True Then
3015 myValueData = "1"
3016 Else
3017 myValueData = "0" 'Do not launch Acrobat when we
create the .PDF file
3019 End If
3020 regKeyValueSet mRegHKeyCurrent User, mPdfWriterKeyNa me, myValueName,
myValueData, mRegSz, myErrorMessage
3029 End If

3160 myPdfFileName = legalFileName(t hePdfFileNameRa w)
3170 myPdfFilePath = theOutputDir & "\" & myPdfFileName & ".pdf"

3200 Select Case mCurDevMode.int Orientation
Case rporient_Portra it
3211 myAcrobatOrient ation = "1"

3220 Case rporient_landsc ape
3221 myAcrobatOrient ation = "2"

3230 Case Else
3231 errorLogWrite "Unexpected case = " & Str(mCurDevMode .intOrientation )
& ". Invalid orientation should have been caught in
validatePrinter PropsAndCapabil ities()."
3299 End Select

3300 Select Case mCurDevMode.int PaperSize
Case rpPaper_Letter
3319 myAcrobatPaperS ize = "0"

3320 Case rpPaper_Legal
3329 myAcrobatPaperS ize = "1"

3330 Case rpPaper_Tabloid
3339 myAcrobatPaperS ize = "2"

3340 Case rpPaper_A4, rpPaper_A4_Smal l
3349 myAcrobatPaperS ize = "3"

3350 Case rpPAPER_A3
3359 myAcrobatPaperS ize = "4"

3360 Case rpPaper_Executi ve
3369 myAcrobatPaperS ize = "5"

3370 Case rpPaper_B4
3379 myAcrobatPaperS ize = "6"

3380 Case rpPaper_B5
3389 myAcrobatPaperS ize = "7"

3490 Case Else
3499 errorListAdd ".PaperSize : Values allowed with PDF Writer are: " _
& Format$(rpPaper _Letter, "0#") & " = Letter" _
& myDelim & Format$(rpPaper _Legal, "0#") & " = Legal" _
& myDelim & Format$(rpPaper _Tabloid, "0#") & " =
Tabloid" _
& myDelim & Format$(rpPaper _Executive, "0#") & " =
Executive" _
& myDelim & Format$(rpPAPER _A3, "0#") & " = A3" _
& myDelim & Format$(rpPaper _A4, "0#") & " = A4" _
& myDelim & Format$(rpPaper _A4_Small, "0#") & " = A4
Small" _
& myDelim & Format$(rpPaper _B4, "0#") & " = B4" _
& myDelim & Format$(rpPaper _B5, "0#") & " = B5" _
& myDelim & " Value specified = " &
Format$(mCurDev Mode.intPaperSi ze & "", "0#") & "."
3500 End Select
2599 pdfRegistrySet = True 'We don't want to
return False if the only problem is validation

3700 If (Len(myAcrobatO rientation) > 0) And (Len(myAcrobatP aperSize) > 0) Then
3701 pdfRegistrySet = False
3710 myValueName = "PDFFileNam e"
3711 myValueData = myPdfFilePath
3712 regKeyValueSet mRegHKeyCurrent User, mPdfWriterKeyNa me, myValueName,
myValueData, mRegSz, myErrorMessage

3720 myValueName = "paper"
3721 myValueData = myAcrobatPaperS ize
3722 regKeyValueSet mRegHKeyCurrent User, mPdfWriterKeyNa me, myValueName,
myValueData, mRegSz, myErrorMessage

3730 myValueName = "orient"
3731 myValueData = myAcrobatOrient ation
3732 regKeyValueSet mRegHKeyCurrent User, mPdfWriterKeyNa me, myValueName,
myValueData, mRegSz, myErrorMessage

3740 myValueName = "bDocInfo"
3741 myValueData = "0"
3742 regKeyValueSet mRegHKeyCurrent User, mPdfWriterKeyNa me, myValueName,
myValueData, mRegSz, myErrorMessage

3745 myValueName = "bEmbedAllFonts "
3746 myValueData = "0"
3747 regKeyValueSet mRegHKeyCurrent User, mPdfWriterKeyNa me, myValueName,
myValueData, mRegSz, myErrorMessage

3750 pdfRegistrySet = True
3999 End If

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite "Raw PDF FileName = '" & thePdfFileNameR aw & ", Papersize=" &
Str(mCurDevMode .intPaperSize) & ", Orientation=" &
Str(mCurDevMode .intOrientation ) & ", Output Dir='" & theOutputDir & "', Path =
'" & myPdfFilePath & "',"
Resume Xit
End Function
Private Function regKeyValueGet( ByVal theRootKey As Long, ByVal theKeyName As
String, ByVal theValueName As String, ByRef theReturnValue As Variant) As
Boolean
2000 callStackPush mModuleName, "regKeyValueGet "
2001 On Error GoTo catchError

' ACCEPTS: - The root key value, which must be one of the following
constants:
' + gRegHKeyClasses Root
' + gRegHKeyCurrent User
' + gRegHKeyLocalMa chine
' + gRegHKeyUsers
' - Name of the key to open
' - Name of the value to open. "vbNullStri ng" will open the
default value.
' RETURNS: TRUE or FALSE depending on success
' SETS: Variant containing the registry value's data or an error message
'
' EXAMPLE: x = regKeyValueGet( gRegHKeyLocalMa chine,
"Software\ODBC\ ODBC.INI\AGENCY ", "ServerName ", myValueData)

2010 Dim myKeyHandle As Long
Dim myStringValue As String
Dim myLongValue As Long
Dim myValueType As Long
Dim myDataLength As Long
Dim x As Long

2020 theReturnValue = Empty

2030 x = RegOpenKeyEx(th eRootKey, theKeyName, 0&, mRegKeyQueryVal ue,
myKeyHandle)
2040 If x <> 0 Then
2050 theReturnValue = "[ERROR " & Str(x) & " returned by RegOpenKeyEx]"
2060 Else
2070 x = RegQueryValueEx A(myKeyHandle, theValueName, 0&, myValueType, 0&,
myDataLength)
2080 If x <> 0 Then
2090 If x = 2 Then
2100 theReturnValue = "[ERROR " & Str(x) & ": key not
found....Return ed by RegQueryValueEx A]"
2110 Else
2120 theReturnValue = "[ERROR " & Str(x) & " returned by
RegQueryValueEx A]"
2130 End If
2140 Else
2141 If myDataLength > 0 Then
2150 Select Case myValueType
Case mRegSz: ' String
2170 myStringValue = String(myDataLe ngth - 1, 0)
2180 x = RegQueryValueEx String(myKeyHan dle, theValueName, 0&,
myValueType, myStringValue, myDataLength)
2190 If x <> 0 Then
2200 theReturnValue = "[ERROR " & Str(x) & " returned by
RegQueryValueEx String]"
2210 Else
2220 theReturnValue = Left$(myStringV alue, myDataLength)
2230 regKeyValueGet = True
2240 End If

2250 Case mRegDWord: ' Long
x = RegQueryValueEx Long(myKeyHandl e, theValueName, 0&,
myValueType, myLongValue, myDataLength)
2260 If x <> 0 Then
2270 regKeyValueGet = "[ERROR " & Str(x) & " returned by
RegQueryValueEx Long]"
2280 Else
2290 theReturnValue = myLongValue
2300 regKeyValueGet = True
2310 End If

2320 Case Else ' No other
data types supported
2321 errorLogWrite "Unexpected case: " & Str(myValueType ) & ".
Only String and Long supported"
2330 End Select
2335 End If
2340 End If
2999 End If

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Function
Private Function pdfRegistryGet( ) As String
callStackPush mModuleName, "pdfRegistryGet "
On Error GoTo catchError

' PURPOSE: To assist debugging by retrieving all the PDF-specific registry
entires.
' RETURNS: Registry Entries

Dim myString As String
Dim myValue1 As String
Dim myValue2 As String
Dim myValue3 As String

Const myValueName1 = "bDocInfo"
Const myValueName2 = "PDFFileNam e"
Const myValueName3 = "TPDFFileNa me"

If regKeyValueGet( mRegHKeyCurrent User, mPdfWriterKeyNa me, myValueName1,
myValue1) = False Then
myValue1 = "(key not found in registry)"
End If

If regKeyValueGet( mRegHKeyCurrent User, mPdfWriterKeyNa me, myValueName2,
myValue2) = False Then
myValue2 = "(key not found in registry)"
End If

If regKeyValueGet( mRegHKeyCurrent User, mPdfWriterKeyNa me, myValueName3,
myValue3) = False Then
myValue3 = "(key not found in registry)"
End If

myString = myValueName1 & " = '" & myValue1 & "'" & vbCrLf & myValueName2 & "
= '" & myValue2 & "'" & vbCrLf & myValueName3 & " = '" & myValue3 & "'"
pdfRegistryGet = myString

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Function
Private Sub printerArrayLoa d()
callStackPush mModuleName, "printerArrayLo ad"
On Error GoTo catchError

' PURPOSE: To load the class' array with all printers currently installed on
' this PC by referring to (the [devices] section in WIN.INI???)
' RETURNS: A collection as above
'
' NOTES: 1) I'm not positive that we're not going to the registry
' 1) When we loop through the list of printers, we assume that
' no two printers have the same name.
' 2 A given INI/Registry entry for a printer will look like this:
' "HP DeskJet 890C Series=winspool ,LPT1:"
' so we split it twice: first on "=" and then we split the
' result of the "=" split on ",".

Dim myIniSectionArr ay() As String
Dim myIniDetailsArr ay1() As String
Dim myIniDetailsArr ay2() As String

Dim i As Integer
Dim k As Integer
Dim myParmCount As Integer
Dim myIniSection As String

myIniSection = iniSectionGet(" Devices")

If Len(myIniSectio n) = 0 Then
myParmCount = 0
Else
myIniSectionArr ay = Split(myIniSect ion, vbNullChar)
ReDim aDevList(LBound (myIniSectionAr ray) To UBound(myIniSec tionArray))
For i = LBound(myIniSec tionArray) To UBound(myIniSec tionArray)
If Len(myIniSectio nArray(i)) > 0 Then
myIniDetailsArr ay1 = Split(myIniSect ionArray(i), "=")
myIniDetailsArr ay2 = Split(myIniDeta ilsArray1(1), ",")
k = k + 1
ReDim Preserve mCurPrinters(k)
With mCurPrinters(k)
.DeviceName = myIniDetailsArr ay1(0)
.DriverName = myIniDetailsArr ay2(0)
.Port = myIniDetailsArr ay2(1)
End With
End If
Next i
End If

Xit:
callStackPop
On Error Resume Next
Exit Sub

catchError:
errorLogWrite ""
Resume Xit
End Sub
Private Function printerGet(ByVa l thePrinterName As String) As mPrinterStruct
7000 callStackPush mModuleName, "printerGet "
7001 On Error GoTo catchError

' PURPOSE: To allow using routines to retrieve a named printer
' from the class' array
' ACCEPTS: UNC of the printer. e.g. \\NTPRT07\INVHP 5SI
' RETURNS: Struct containing printer info: populated or empty, depending...
'
' NOTES: 1) There is no guarantee that the mCurPrinters has been loaded
because
' the PC may not have any printers installed. For want of a
better
' method, we detect this situation by trapping for a subscript
range error.

7002 Dim myPrinter As mPrinterStruct
Dim i As Integer
Dim gotPrinter As Boolean

Const subscriptOutOfR ange = 9

7010 For i = 0 To UBound(mCurPrin ters)
7020 With mCurPrinters(i)
7030 If .DeviceName = thePrinterName Then
7040 myPrinter.IsDef aultPrinter = .IsDefaultPrint er
7050 myPrinter.Devic eName = .DeviceName
7060 myPrinter.Drive rName = .DriverName
7070 myPrinter.Port = .Port
7080 gotPrinter = True
7090 Exit For
7100 End If
7110 End With
7120 Next i

7999 printerGet = myPrinter

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
Select Case Err
Case subscriptOutOfR ange
'(do nothing, indicates that no printers are installed)
Case Else
errorLogWrite ""
End Select
Resume Xit
End Function
Private Function printerDefaultG et() As mPrinterStruct
callStackPush mModuleName, "printerDefault Get"
On Error GoTo catchError

' PURPOSE: Get information on the Windows default printer
' RETURNS: Structure
'
' NOTES: 1) The default printer name string has to contain
' three elements delimited by comma. If not, we
' have a trappable error

Dim myPrinter As mPrinterStruct
Dim myDetailsArray( ) As String
Dim strPrinter As String

strPrinter = printerDefaultI nfoGet()
If Len(strPrinter) > 0 Then
myDetailsArray = Split(strPrinte r, ",")
With myPrinter
.DeviceName = myDetailsArray( 0)
.DriverName = myDetailsArray( 1)
.Port = myDetailsArray( 2)
End With
End If

printerDefaultG et = myPrinter

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Function
Private Function printerDefaultI nfoGet() As String
callStackPush mModuleName, "printerDefault InfoGet"
On Error GoTo catchError

' PURPOSE: To get the current default printer's information string
' RETURNS: String containing printer's information or, if no default printer,
empty string

Dim myBuff As String
Dim myBuffLen As Integer

Const myBuffLim = 2048
Const noPrintersFound = ""

myBuff = Space(myBuffLim )
myBuffLen = GetProfileStrin g("Windows", "Device", noPrintersFound , myBuff,
myBuffLim - 1)

printerDefaultI nfoGet = Left$(myBuff, myBuffLen)

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Function
Public Property Get Help()
callStackPush mModuleName, "Help"
On Error GoTo catchError

' PURPOSE: - To act as a repository for documentation of this function's methods
and properties
' - To allow the calling routine to show same

MsgBox "This is a stub for yet-to-be-implemented 'Help' method." & vbCrLf &
vbCrLf & "The final product may document the class' methods and properties and
show some sample code by creating/opening an HTML document.", vbInformation,
"Under Construction"

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property
Private Function iniSectionGet(B yVal theGroupRequest ed As String) As String
callStackPush mModuleName, "iniSection Get"
On Error GoTo catchError

' PURPOSE: To retrieve an entire section from Win.INI.
' ACCEPTS: The name of the group we want to get
' RETURNS: A string containing the contents of the group (exclusive of header)
'
' NOTES: 1) Used to get a list of all the printers
' 2) CAVEAT: I suspect that the API call really goes to the
' registry, since I can't find a section in my own
' machine's WIN.INI that has printers in it.

Dim myBuff As String
Dim myBuffLen As Integer

Const myBuffLim = 10000

myBuff = Space(myBuffLim )
myBuffLen = GetProfileSecti on(theGroupRequ ested, myBuff, myBuffLim - 1)

iniSectionGet = Left$(myBuff, myBuffLen)

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Function
Private Sub errorLogWrite(B yVal theSupplemental Message As String)

' PURPOSE: - To write the passed information to the .ErrorList
' - To make the error bubble up to whatever client is using this
class.
' - If .ErrorLogPath specified, to write the information there,
otherwise write
' it to a default path.
'
' ACCEPTS: Programmer-supplied supplemental description
' USES: .ErrorLogPath property defining log file directory and file name
'
' NOTES: 1) First thing we have to do is capture all of the "real" error's
properties.
' 2) "noLocalErr or" is needed because we also might raise an error
in this routine (i.e. a "local"
' error).
' 3) We also post the error to the class' mCurErrorList so it will
affect the
' result of any attempt to do a .PrintReport. We do not call
errorListAdd()
' because we don't want to invoke it's error trapping - since it
would be
' recursive as we are already in error mode
' 4) If .ErrorLogPath has been specified, we have already validated
it before coming here.
' 5) The assumption is that drive C: exists.

1000 Dim myErl As Long
Dim myNumber As Long
Dim mySource As String
Dim myDescription As String
Dim myString As String

1040 myErl = Erl
1041 myNumber = Err.Number
1042 mySource = Err.Source
1049 myDescription = Err.description

1050 On Error GoTo errorLogWrite_x it
1051 DoCmd.Echo True 'In case it was turned off
somewhere else

1060 If myErl = 0 Then
1061 mySource = mySource & ":" & mCallStack(mCal lStackPointer)
1062 Else
1063 mySource = mySource & ":" & mCallStack(mCal lStackPointer) & ": Line# " &
Str(myErl)
1069 End If
1070 mCurErrorCount = mCurErrorCount + 1
1079 myString = mErrorListMessa gePrefix & "RUN-TIME ERROR @" & mySource & " --
Error# " & Format$(myNumbe r, "0000") & ": " & myDescription & " " &
theSupplemental Message

1080 If Len(mCurErrorLi st) = 0 Then
1081 mCurErrorList = myString
1082 Else
1083 mCurErrorList = mCurErrorList & vbCrLf & myString
1089 End If
1100 Dim i As Integer
1110 Dim x As Integer
1115 Dim noLocalError As Boolean
1120 Dim ErrorLogPath As String

1240 ErrorLogPath = errorLogPathGet ()

1300 mySource = vbTab & "This error bubbled up from: " & mySource

1310 x = FreeFile
1320 Open ErrorLogPath For Append As x

1400 Print #x,
"--------------------------------------------------------------------"
1410 Print #x, Format$("When: " & Now, "mm/dd/yy hh:nn:ss") & ", Who: " &
userNameGet() & ", What: " & computerNameGet () & ", Where: " &
mCallStack(mCal lStackPointer)
1420 If myErl > 0 Then
1430 Print #x, String(13, " ") & "Line " & Format$(myErl, "000000") & " " &
Format$(myNumbe r, "0000") & ": " & myDescription
1440 Else
1450 Print #x, String(13, " ") & Format$(myNumbe r, "0000") & ": " &
myDescription
1460 End If
1470 If theSupplemental Message <> "" Then
1480 Print #x, Space$(19) & theSupplemental Message
1490 End If

1500 Print #x, ""

1600 If mCallStackPoint er > 1 Then
1610 For i = 0 To mCallStackLim
1620 If mCallStack(i) <> "" Then
1630 If i = mCallStackPoint er Then
1640 Print #x, Space$(9) & " " & Format(i, "00") & ">>" &
mCallStack(i)
1650 Else
1660 If i = 1 Then
1670 Print #x, Space$(9) & "CallOuts: " & Format(i, "00") & " "
& mCallStack(i)
1680 Else
1690 Print #x, Space$(9) & " " & Format(i, "00") & " "
& mCallStack(i)
1700 End If
1710 End If
1720 End If
1730 Next i
1740 End If

1900 Close #x
1999 noLocalError = True

errorLogWrite_x it:
If noLocalError = True Then
If myNumber = 0 Then
myNumber = 999 'In case we called errorLogWrite just for
informational purposes.
End If
' On Error Resume Next
Err.Raise myNumber, mySource & vbCrLf & vbTab & myDescription & vbCrLf &
vbTab & "This text is also logged in '" & ErrorLogPath & "'."
Else
Err.Raise Err.Number, Err.Source & ":" & "errorLogWr ite, line " & Erl & "
(error in error handler)", Err.description
End If
Exit Sub
End Sub
Private Sub callStackPop()

' PURPOSE: To remove most-recently-added procedure name from the debug stack
array

On Error Resume Next 'To prevent looping if/when stack gets
overflowed...

mCallStack(mCal lStackPointer) = ""
mCallStackPoint er = mCallStackPoint er - 1

If mCallStackPoint er < 0 Then
mCallStackPoint er = 0
End If

Exit Sub
End Sub
Private Sub callStackPush(B yVal theModuleName As String, ByVal theProcedureNam e
As String)

' PURPOSE: To add "theProcedureNa me" to the debug stack array

' NOTES: 1)If the programmer invokes this routine but neglects to invoke
"callStackP op"
' at the end of the procedure, there is a chance that the stack will
get
' overflowed. Therefore we have some error handling at the end to
track
' such situations. "overflowLogged " is a switch we use to prevent
an undue
' number of writes.

On Error GoTo callStackPush_e rr

Static overflowLogged As Boolean

mCallStackPoint er = mCallStackPoint er + 1
mCallStack(mCal lStackPointer) = theModuleName & ":" & theProcedureNam e

callStackPush_x it:
Exit Sub

callStackPush_e rr:
If overflowLogged = False Then
errorLogWrite "Call Stack Overflow: Stack = " & Str(mCallStackP ointer) & "
(Stack Limit = " & Str(mCallStackL im)
End If
overflowLogged = True
Resume callStackPush_x it
End Sub
Private Function userNameGet() As String
On Error Resume Next

' PURPOSE: To extract the LAN userID of the person currently logged on
' RETURNS: UserID or blank string
'
' NOTES: 1) NO ERROR TRAPPING. Tailored for use during errorLogWrite process.
' To avoid recursive loops, there are no calls to errorLogWrite
routines.

Dim L As Long
Dim myBuffer As String

Const buffLen = 255

myBuffer = Space(buffLen)

L = GetUserName(myB uffer, buffLen)

userNameGet = stripNulls_elw( myBuffer)
End Function
Private Function computerNameGet () As String
On Error Resume Next

' PURPOSE: To extract the name of the user's PC via Windows API
'
' NOTES: 1) NO ERROR TRAPPING. Tailored for use during errorLogWrite process.
' To avoid recursive loops, there are no calls to errorLogWrite
routines.

Dim L As Long
Dim myBuffer As String

Const buffLen = 255

myBuffer = Space(buffLen)

L = GetComputerName (myBuffer, buffLen)

computerNameGet = stripNulls_elw( myBuffer)

End Function
Private Function stripNulls_elw( ByVal theStringWithNu lls As String) As String
On Error Resume Next

' PURPOSE: To strip any nulls out of the passed string
' ACCEPTS: The string we want to strip nulls out of
' RETURNS: A copy of the passed string with nulls stripped
'
' NOTES: 1) NO ERROR TRAPPING. Tailored for use during errorLogWrite
process. To avoid recursive loops,
' there are no calls to errorLogWrite routines.

Dim myString As String

If InStr(1, theStringWithNu lls, Chr(0), vbTextCompare) Then
myString = Mid(theStringWi thNulls, 1, InStr(theString WithNulls, Chr(0)) -
1)
Else
myString = theStringWithNu lls
End If

stripNulls_elw = myString
End Function
Private Function errorLogPathGet () As String

' PURPOSE: To build the path where we write our errors to
'
' NOTES: 1) NO ERROR TRAPPING. Tailored for use during errorLogWrite process.
' To avoid recursive loops, there are no calls to errorLogWrite
routines.

Dim myAppDir As String

Const defaultErrorLog Name = "clsReportPrint er.ErrorLog.txt "

If Len(mCurErrorLo gPath) = 0 Then
myAppDir = extractDirFromF ullPath_elw(App lication.Curren tDb.Name)
errorLogPathGet = myAppDir & "\" & defaultErrorLog Name
Else
errorLogPathGet = mCurErrorLogPat h
End If
End Function
Function fileExist(ByVal theFilePath As Variant) As Integer
callStackPush mModuleName, "fileExist"
On Error GoTo catchError

' PURPOSE: To determine whether-or-not a file exists
' ACCEPTS: A full path to the file in question
' RETURNS: True or False depending...
'
' NOTES: 1) If we drop into the errro trap, not only does
' the file does not exist, but something unexpected
' has happened

fileExist = (Dir$(theFilePa th) <> "")

fileExist_xit:
debugStackPop
On Error Resume Next
Exit Function

catchError:
Select Case Err
Case 71
'(Do nothing because we are not in a position to pop error messages)
' MsgBox "That path refers to a floppy disk. Please insert the disk.", 49,
"Insert Disk"

Case 76
'(We can expect 76 if no file found)

Case 68
'(Do nothing because we are not in a position to pop error messages)
' MsgBox "The system has reported that drive " & UCase$(Left$(th eFilePath,
2)) & " is unavailable." & skipLine & "One possibility is that you specified the
wrong drive; another is that there is a problem with your LAN logon.", 16,
"Cannot find Drive"

Case Else
errorLogWrite "Unexpected error encountered when checking for existance of
a file."
End Select

Resume fileExist_xit
End Function
Private Function validateErrorFi lePath(ByVal theFilePath As String) As Boolean
5000 callStackPush mModuleName, "validateErrorF ilePath"
5001 On Error GoTo catchError

' PURPOSE: To validate the error log path by seeing if we can create a file.
'
' NOTES: 1) We cannot log an error message because the main use of this
routine
' is to validate the error log path. Instead, we append a message
' to .ErrorList.
' 2) We do the Dir$() without error trapping because it will generate
' an error 52 in addition to returning an empty string if we feed it
' a UNC with non-existant file name.
' 3) If we feed a path lacking either drive letter or server\sharenam e
' to "Open" it seems to handle it without error, but we can't figure
' out where the file was created.
' Therefore we check for a drive or UNC first.

5002 Dim x As Integer
Dim myErl As Long
Dim myNumber As Long
Dim mySource As String
Dim myDescription As String
Dim myString As String
Dim myReturnValue As String

Const pathNotFound = 76
Const badFileNameOrNu mber = 52
Const pathFileAccessE rror = 75

5010 If (Mid$(theFilePa th, 2, 1) = ":") Or (Left$(theFileP ath, 2) = "\\") Then

On Error Resume Next
myReturnValue = Dir$(theFilePat h)
On Error GoTo catchError

5020 If Len(myReturnVal ue) > 0 Then
5021 validateErrorFi lePath = True
5029 Else
5030 x = FreeFile
5031 Open theFilePath For Append As x
5032 Close x
5033 Kill theFilePath
5039 validateErrorFi lePath = True
598 End If
5999 End If

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
myErl = Erl
myNumber = Err.Number
mySource = Err.Source
myDescription = Err.description
On Error Resume Next

Select Case myNumber
Case pathNotFound, badFileNameOrNu mber, pathFileAccessE rror
'(do nothing, these errors simply confirm that the path is bad)
Case Else
myString = "PROGRAM ERROR @" & mySource & " -- Error# " &
Format$(myNumbe r, "0000") & ": " & myDescription & "."
errorListAdd myString
End Select

Resume Xit
End Function
Private Function driverGetPointA rray(ByVal theDeviceCapabi lityType As
mDeviceCapabili tyTypes, ByRef thePrinter As mPrinterStruct) As mXyPoint()
callStackPush mModuleName, "driverGetPoint Array"
On Error GoTo catchError

' PURPOSE: To retrieve an array of x-y coordinates type values (each one is a
pair
' of integers) from a printer's driver
' ACCEPTS: - A constant telling what capability we are looking for. e.g.
Printer resolution
' - A printer struct containing name, port of printer
' RETURNS: An array of the coordinates found
'
' NOTES: 1) The DeviceCapabilit ies() API call returns -1 upon failure

Dim myPointList() As mXyPoint
Dim myListCount As Long
Dim L As Long

myListCount = DeviceCapabilit iesLng(thePrint er.DeviceName, thePrinter.Port ,
theDeviceCapabi lityType, 0, 0)
If myListCount = -1 Then
errorLogWrite "Unable to retrieve device capability count for type" &
Str(theDeviceCa pabilityType)
Else
If myListCount > 0 Then
ReDim myPointList(0 To myListCount - 1)
L = DeviceCapabilit iesAny(thePrint er.DeviceName, thePrinter.Port ,
theDeviceCapabi lityType, myPointList(0), 0)
If L = -1 Then
errorLogWrite "Unable to retrieve device capability list for type" &
Str(theDeviceCa pabilityType)
End If
End If
End If

driverGetPointA rray = myPointList

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Function
Private Sub validatePrinter PropsAndCapabil ities(ByRef thePrinter As
mPrinterStruct)
callStackPush mModuleName, "validatePrinte rPropsAndCapabi lities"
On Error GoTo catchError

' PURPOSE: To check printer options supplied by caller against possible
capapbilities
' AND against capabilities supported by chosen printer
' ACCEPTS: Struct containing name, port of chosen printer
' SETS: - mCurErrorCount (incremented for each incompatibility found via
'errorListAdd')
' - mCurErrorList (an error description added for each incompatability
found via 'errorListAdd')
'
Dim myPrinterDm As mPrtDevModeStru ct
Dim myPointArray() As mXyPoint
Dim myCurRez As mXyPoint
Dim myStringArray() As String
Dim myArraySize As Long
Dim capabilitySuppo rted As Boolean
Dim valuesFound As String
Dim myMsg As String

Dim B As Boolean
Dim L As Long
Dim i As Integer

Const myIndent = 6
Const myDelim = ", "

myPrinterDm = printerDevModeG et(thePrinter.D eviceName)

With mCurDevMode
' ---------------------------------------------
' Collate

Select Case .intCollate
Case rpCollate_False
'(do nothing)
Case rpCollate_True
If myPrinterDm.int Collate <> rpCollate_True Then
errorListAdd ".Collate: Collating requested, but printer " &
thePrinter.Devi ceName & " does not support collating. Value specified = " &
Str(.intCollate ) & ". "
End If
Case Else
errorListAdd ".Collate: Values allowed = " & Format$(rpColla te_True,
"#0") & " = True" & myDelim & Format$(rpColla te_False, "#0") & " = False.
Value specified = " & Str(.intCollate ) & ". "
End Select

' ---------------------------------------------
' Color

Select Case .intColor
Case rpColor_Monochr ome
'(do nothing)
Case rpColor_Color
If myPrinterDm.int Color <> rpColor_Color Then
errorListAdd ".Color: Color printing requested, but printer " &
thePrinter.Devi ceName & " does not support color printing."
End If
Case Else
errorListAdd ".Color: Values allowed = " & Format$(rpColor _Monochrome,
"#0") & " = Monochrome" & myDelim & Format$(rpColor _Color, "#0") & " = Color.
Value specified = " & Str(.intColor) & ". "
End Select

' ---------------------------------------------
' Copies

L = driverGetNumeri cValue(dcCopies , thePrinter)
If L < .intCopies Then
errorListAdd ".Copies: Max copies allowed by printer " &
thePrinter.Devi ceName & " = " & Format$(L, "#0") & ". Value specified = " &
Format$(.intCop ies, "#0") & "."
End If

' ---------------------------------------------
' DefaultSource NOT CHECKED AGAINST PRINTER CAPABILITIES

Select Case .intDefaultSour ce
Case rpSrc_Upper, rpSrc_OnlyOne, rpSrc_Lower, rpSrc_Middle,
rpSrc_Manual_Fe ed, rpSrc_Envelope, _
rpSrc_Envelope_ Manual_Feed, rpSrc_Auto, rpSrc_Tractor,
rpSrc_Small_For mat, rpSrc_Large_For mat, _
rpSrc_Large_Cap acity, rpSrc_Cassette, rpSrc_Form_Sour ce, rpSrc_User
'(do nothing)
Case Else
errorListAdd ".DefaultSource : Values allowed = " & _
Format$(rpSrc_U pper, "#0") & " = Upper tray" & myDelim & _
Format$(rpSrc_O nlyOne, "#0") & " = Only Tray" & myDelim & _
Format$(rpSrc_L ower, "#0") & " = Lower Tray" & myDelim & _
Format$(rpSrc_M iddle, "#0") & " = Middle Tray" & myDelim & _
Format$(rpSrc_M anual_Feed, "#0") & " = Manual Feed" & myDelim & _
Format$(rpSrc_E nvelope, "#0") & " = Envelope (from tray)" & myDelim
& _
Format$(rpSrc_E nvelope_Manual_ Feed, "#0") & " = Envelope (manually
fed)" & myDelim & _
Format$(rpSrc_A uto, "#0") & " = Auto" & myDelim & _
Format$(rpSrc_T ractor, "#0") & " = Tractor" & myDelim & _
Format$(rpSrc_S mall_Format, "#0") & " = Small-Format Tray" &
myDelim & _
Format$(rpSrc_L arge_Format, "#0") & " = Large-Format Tray" &
myDelim & _
Format$(rpSrc_L arge_Capacity, "#0") & " = Large-Capacity Tray" &
myDelim & _
Format$(rpSrc_C assette, "#0") & " = Cassette" & myDelim & _
Format$(rpSrc_F orm_Source, "#0") & " = Form Tray" & myDelim & _
Format$(rpSrc_U ser, "#0") & " = User-Specified." & _
" Value specified = " & Str(.intDefault Source) & ". "
End Select

' ---------------------------------------------
' Duplex

If Not IsNull(.intDupl ex) Then
If (.intDuplex < 1) Or (.intDuplex > 3) Then
errorListAdd ".Duplex: Values allowed = 1 (simplex), 2 (horizontal),
and 3 (vertical). Value specified =" & Str(.intDuplex) & "."
Else
If (.intDuplex > 1) And (Not myPrinterDm.int Duplex > 1) Then
errorListAdd ".Duplex: Duplex option requested, but " &
thePrinter.Devi ceName & " does not support duplexing. Value specified =" &
Str(.intDuplex) & "."""
End If
End If
End If
' ---------------------------------------------
' Orientation (WE ASSUME THAT ALL PRINTERS SUPPORT PORTRAIT)

Select Case .intOrientation
Case rporient_Portra it
'(do nothing)
Case rporient_landsc ape
L = driverGetNumeri cValue(dcOrient ation, thePrinter)
If L = 0 Then
errorListAdd ".Orientati on: Landscape requested, but " &
thePrinter.Devi ceName & " does not support landscape orientation. Value
specified =" & Str(.intOrienta tion) & "."""
End If

Case Else
errorListAdd ".Orientati on: Values allowed = " &
Format$(rporien t_Portrait, "#0") & " = Portrait" & myDelim &
Format$(rporien t_landscape, "#0") & " = Landscape. Value specified = " &
Str(.intOrienta tion) & ". "
End Select
' ---------------------------------------------
' PaperLength (NOT IMPLEMENTED)

' ---------------------------------------------
' PaperSize

Select Case .intPaperSize
Case rpSrc_Upper, rpSrc_OnlyOne, rpSrc_Lower, rpSrc_Middle,
rpSrc_Manual_Fe ed, rpSrc_Envelope, _
rpSrc_Envelope_ Manual_Feed, rpSrc_Auto, rpSrc_Tractor,
rpSrc_Small_For mat, rpSrc_Large_For mat, _
rpSrc_Large_Cap acity, rpSrc_Cassette, rpSrc_Form_Sour ce, rpSrc_User
'(do nothing)
Case Else
myMsg = ".PaperSize : Values allowed = "
myMsg = myMsg & Format$(rpPaper _Letter, "#0") & " = Letter 8 1/2 x
11 in" & myDelim
myMsg = myMsg & Format$(rpPaper _LetterSmall, "#0") & " = Letter
Small 8 1/2 x 11 in" & myDelim
myMsg = myMsg & Format$(rpPaper _Tabloid, "#0") & " = Tabloid 11 x
17" & myDelim
myMsg = myMsg & Format$(rpPaper _Ledger, "#0") & " = Ledger 17 x 11"
& myDelim
myMsg = myMsg & Format$(rpPaper _Legal, "#0") & " = Legal 8 1/2 x
14" & myDelim
myMsg = myMsg & Format$(rpPaper _Statement, "#0") & " = Statement 5
1/2 x 8 1/2" & myDelim
myMsg = myMsg & Format$(rpPaper _Executive, "#0") & " = Executive 7
1/4 x 10 1/2" & myDelim
myMsg = myMsg & Format$(rpPAPER _A3, "#0") & " = A3 297 x 420 mm" &
myDelim
myMsg = myMsg & Format$(rpPaper _A4, "#0") & " = A4 210 x 297 mm" &
myDelim
myMsg = myMsg & Format$(rpPaper _A4_Small, "#0") & " = A4 Small 210
x 297 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _A5, "#0") & " = A5 148 x 210 mm" &
myDelim
myMsg = myMsg & Format$(rpPaper _B4, "#0") & " = B4 (JIS) 250 x 354
mm" & myDelim
myMsg = myMsg & Format$(rpPaper _B5, "#0") & " = B5 (JIS) 182 x 257
mm" & myDelim
myMsg = myMsg & Format$(rpPaper _FOLIO, "#0") & " = Folio 8 1/2 x
13" & myDelim
myMsg = myMsg & Format$(rpPaper _QUARTO, "#0") & " = Quarto 215 x
275 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _10X14, "#0") & " = 10x14 in" &
myDelim
myMsg = myMsg & Format$(rpPaper _11X17, "#0") & " = 11x17 in" &
myDelim
myMsg = myMsg & Format$(rpPaper _NOTE, "#0") & " = Note 8 1/2 x 11
in" & myDelim
myMsg = myMsg & Format$(rpPaper _Env_9, "#0") & " = Envelope #9 3
7/8 x 8 7/8" & myDelim
myMsg = myMsg & Format$(rpPaper _Env_10, "#0") & " = Envelope #10 4
1/8 x 9 1/2" & myDelim
myMsg = myMsg & Format$(rpPaper _Env_11, "#0") & " = Envelope #11 4
1/2 x 10 3/8" & myDelim
myMsg = myMsg & Format$(rpPaper _Env_12, "#0") & " = Envelope #12 4
\276 x 11" & myDelim
myMsg = myMsg & Format$(rpPaper _Env_14, "#0") & " = Envelope #14 5
x 11 1/2" & myDelim
myMsg = myMsg & Format$(rpPaper _C_Sheet, "#0") & " = C size sheet"
& myDelim
myMsg = myMsg & Format$(rpPaper _D_Sheet, "#0") & " = D size sheet"
& myDelim
myMsg = myMsg & Format$(rpPaper _E_Sheet, "#0") & " = E size sheet"
& myDelim
myMsg = myMsg & Format$(rpPaper _Env_DL, "#0") & " = Envelope DL 110
x 220mm" & myDelim
myMsg = myMsg & Format$(rpPaper _Env_C5, "#0") & " = Envelope C5 162
x 229 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _Env_C3, "#0") & " = Envelope C3
324 x 458 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _Env_C4, "#0") & " = Envelope C4
229 x 324 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _Env_C6, "#0") & " = Envelope C6
114 x 162 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _Env_B4, "#0") & " = Envelope B4
250 x 353 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _Env_B5, "#0") & " = Envelope B5
176 x 250 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _Env_B6, "#0") & " = Envelope B6
176 x 125 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _Env_ITALY, "#0") & " = Envelope 110
x 230 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _Env_Monarch, "#0") & " = Envelope
Monarch 3.875 x 7.5" & myDelim
myMsg = myMsg & Format$(rpPaper _Env_Personal, "#0") & " = Envelope
3 5/8 x 6 1/2" & myDelim
myMsg = myMsg & Format$(rpPaper _FanFold_US, "#0") & " = US Std
Fanfold 14 7/8 x 11" & myDelim
myMsg = myMsg & Format$(rpPaper _FanFold_Std_Ge rman, "#0") & " =
German Std Fanfold 8 1/2 x 12" & myDelim
myMsg = myMsg & Format$(rpPaper _FanFold_Lgl_Ge rman, "#0") & " =
German Legal Fanfold 8 1/2 x 13" & myDelim
myMsg = myMsg & Format$(rpPaper _ISO_B4, "#0") & " = B4 (ISO) 250 x
353 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _Japanese_Postc ard, "#0") & " =
Japanese Postcard 100 x 148 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _9X11, "#0") & " = 9 x 11" & myDelim
myMsg = myMsg & Format$(rpPaper _10X11, "#0") & " = 10 x 11" &
myDelim
myMsg = myMsg & Format$(rpPaper _15X11, "#0") & " = 15 x 11" &
myDelim
myMsg = myMsg & Format$(rpPaper _Env_Invite, "#0") & " = Envelope,
Invitation 220 x 220 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _Letter_Extra, "#0") & " = Letter
Extra 9 x 12" & myDelim
myMsg = myMsg & Format$(rpPaper _LEGAL_Extra, "#0") & " = Legal
Extra 9 x 15" & myDelim
myMsg = myMsg & Format$(rpPaper _Tabloid_Extra, "#0") & " = Tabloid
Extra 11.69 x 18" & myDelim
myMsg = myMsg & Format$(rpPaper _A4_Extra, "#0") & " = A4 Extra 9.27
x 12.69" & myDelim
myMsg = myMsg & Format$(rpPaper _Letter_Transve rse, "#0") & " = A4
Transverse 210 x 297 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _Letter_Extra_T ransverse, "#0") & "
= Letter Extra Transverse 9\275 x 12" & myDelim
myMsg = myMsg & Format$(rpPaper _A_Plus, "#0") & " =
SuperA/SuperA/A4 227 x 356 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _B_Plus, "#0") & " =
SuperB/SuperB/A3 305 x 487 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _Letter_Plus, "#0") & " = Letter
Plus 8.5 x 12.69" & myDelim
myMsg = myMsg & Format$(rpPaper _A4_Plus, "#0") & " = A4 Plus 210 x
330 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _A5_Transverse, "#0") & " = A5
Transverse 148 x 210 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _B5_Transverse, "#0") & " = B5 (JIS)
Transverse 182 x 257 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _A3_Extra, "#0") & " = A3 Extra 322
x 445 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _A5_Extra, "#0") & " = A5 Extra 174
x 235 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _B5_Extra, "#0") & " = B5 (ISO)
Extra 201 x 276 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _A2, "#0") & " = A2 420 x 594 mm" &
myDelim
myMsg = myMsg & Format$(rpPaper _A3_Transverse, "#0") & " = A3
Transverse 297 x 420 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _A3_Extra_Trans verse, "#0") & " = A3
Extra Transverse 322 x 445 mm" & myDelim
myMsg = myMsg & Format$(rpPaper _User, "#0") & " = (user-defined)" &
myDelim
myMsg = myMsg & " Value specified = " & Str(.intPaperSi ze) & ". "
errorListAdd myMsg

End Select

' ---------------------------------------------
' PaperWidth (NOT IMPLEMENTED)

' ---------------------------------------------
' PrintQuality

If .intPrintQualit y > 0 And (Not .intYResolution > 0) Then
errorListAdd ".PrintQual ity: A positive value in .PrintQuality is
regarded as an x-axis resolution and must be accompanied by a positive value in
..YResolution."
Else
Select Case .intPrintQualit y
Case rpQual_Draft, rpQual_Low, rpQual_Medium, rpQual_High
'(do nothing, these are allowed values)
Case Else
errorListAdd ".PrintQual ity: Allowed negative values are: -1 =
Draft, -2 = Low, -3 = Medium, -4 = High. Value specified = " &
Str(.intPrintQu ality) & ". "
End Select
End If

' ---------------------------------------------
' ScaleAmount (NOT IMPLEMENTED)

' ---------------------------------------------
' TrueType Option (NOT IMPLEMENTED)

' ---------------------------------------------
' YResolution (in conjunction w/PrintQuality)

If .intYResolution > 0 And (Not .intPrintQualit y > 0) Then
errorListAdd ".YResoluti on: If present, YResolution must be accompanied
by a positive value in .PrintQuality, which will function as the x-axis
resolution."
Else
If (.intYResolutio n > 0) And (.intPrintQuali ty > 0) Then
myCurRez.x = .intPrintQualit y
myCurRez.Y = .intYResolution
myPointArray = driverGetPointA rray(dcEnumReso lutions, thePrinter)
myArraySize = UBound(myPointA rray) - 1
capabilitySuppo rted = False
For i = 0 To myArraySize
If (myPointArray(i ).x = myCurRez.x) And (myPointArray(i ).Y =
myCurRez.Y) Then
capabilitySuppo rted = True
End If
Next i
If capabilitySuppo rted = False Then
valuesFound = ""
For i = 0 To myArraySize
If Len(valuesFound ) > 0 Then
valuesFound = valuesFound & ","
End If
valuesFound = valuesFound & Space(myIndent) &
Format$(myPoint Array(i).x, "#0") & "x" & Format$(myPoint Array(i).Y, "#0")
Next i
errorListAdd ".PrintQual ity: Unsupported resolution. Resolutions
supported are " & valuesFound & ". Resolution specified = " &
Format$(myCurRe z.x, "#0") & "x" & Format$(myCurRe z.Y, "#0") & "."
End If
End If
End If
End With

Xit:
callStackPop
On Error Resume Next
Exit Sub

catchError:
errorLogWrite ""
Resume Xit
End Sub
Private Function driverGetString Array(theDevice CapabilityType As
mDeviceCapabili tyTypes, ByRef thePrinter As mPrinterStruct) As String()
callStackPush mModuleName, "driverGetStrin gArray"
On Error GoTo catchError

' PURPOSE: To retrieve an array of strings from a printer's driver
' ACCEPTS: - A constant telling what capability we are looking for. e.g.
Printer resolution
' - A printer struct containing name, port of printer
' RETURNS: Array of strings e.g. Paper Names, File Dependencies, Bin Names
'
' NOTES: 1)We use the DeviceCapabilit ies API call to retrieve a sting of
whatever capabilities
' we're looking for. The raw string is padded with nulls so it
contains fixed-length
' chunks.
' 2) Once we get that string, we use 'StripNulls(Mid $())' to parse it
into our string array.

Dim myStringArray() As String

Dim myListCount As Long
Dim myBuffer As String
Dim L As Long
Dim i As Integer
Dim myStringSize As Integer
Dim okToProceed As Boolean

Const apiCallFailed = -1

Select Case theDeviceCapabi lityType
Case dcPaperNames
myStringSize = mDriverStringLe nPaperName
okToProceed = True
Case dcBinNames
myStringSize = mDriverStringLe nBinName
okToProceed = True
Case dcFileDependenc ies
myStringSize = mDriverStringLe nBinDependency
okToProceed = True
Case Else
errorLogWrite "Unexpected list type:" & Str(theDeviceCa pabilityType)
End Select

If okToProceed = True Then
myListCount = DeviceCapabilit iesLng(thePrint er.DeviceName, thePrinter.Port ,
theDeviceCapabi lityType, 0, 0)
If myListCount = apiCallFailed Then
errorLogWrite "Unable to retrieve list count for " &
Str(theDeviceCa pabilityType)
Else
If myListCount > 0 Then
ReDim myStringArray(0 To myListCount - 1)
myBuffer = String$(myStrin gSize * myListCount, 0)
L = DeviceCapabilit iesStr(thePrint er.DeviceName, thePrinter.Port ,
theDeviceCapabi lityType, myBuffer, 0)
If L = apiCallFailed Then
errorLogWrite "Unable to retrieve list for " &
Str(theDeviceCa pabilityType)
Else
For i = 0 To myListCount - 1
myStringArray(i ) = stripNulls(Mid$ (myBuffer, i * myStringSize
+ 1, myStringSize))
Next i
End If
End If
End If

driverGetString Array = myStringArray
End If
Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Function
Private Function stripNulls(ByVa l theOriginalStri ng As String) As String
callStackPush mModuleName, "stripNulls "
On Error GoTo catchError

' PURPOSE: To remove any nulls from a string
' ACCEPTS: The target string
' RETURNS: Target string with any nulls removed

If InStr(1, theOriginalStri ng, Chr(0), vbTextCompare) Then
theOriginalStri ng = Mid(theOriginal String, 1, InStr(theOrigin alString,
Chr(0)) - 1)
End If

stripNulls = theOriginalStri ng

Xit:
debugStackPop
On Error Resume Next
Exit Function

catchError:
bugAlert True, ""
Resume Xit
End Function
Private Function driverGetNumeri cValue(ByVal theDeviceCapabi lityType As
mDeviceCapabili tyTypes, ByRef thePrinter As mPrinterStruct) As Long
callStackPush mModuleName, "driverGetNumer icValue"
On Error GoTo catchError

' PURPOSE: To retrieve an array of strings from a printer's driver
' ACCEPTS: - A constant telling what capability we are looking for. e.g. Copies
' - A printer struct containing name, port of printer
' RETURNS: A 'Long' value
'F
' NOTES: 1) The DeviceCapabilit ies() API call returns -1 upon failure

Dim L As Long

L = DeviceCapabilit iesLng(thePrint er.DeviceName, thePrinter.Port ,
theDeviceCapabi lityType, 0, 0)
If L = -1 Then
errorLogWrite "Unable to retrieve device capability value for " &
Str(theDeviceCa pabilityType)
End If

driverGetNumeri cValue = L

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Function
Private Function driverGetIntege rArray(ByVal theDeviceCapabi lityType As
mDeviceCapabili tyTypes, ByRef thePrinter As mPrinterStruct) As Integer()
callStackPush mModuleName, "driverGetInteg erArray"
On Error GoTo catchError

' PURPOSE: To retrieve an array of integers from a printer's driver
' ACCEPTS: - A constant telling what capability we are looking for. e.g. Bin
values
' - A printer struct containing name, port of printer
' RETURNS: A 'Long' value
'
' NOTES: 1) The DeviceCapabilit ies() API call returns -1 upon failure

Dim myIntegerArray( ) As Integer

Dim myListCount As Long
Dim L As Long
myListCount = DeviceCapabilit iesLng(thePrint er.DeviceName, thePrinter.Port ,
theDeviceCapabi lityType, 0, 0)
If myListCount = -1 Then
errorLogWrite "Unable to retrieve list count for " &
Str(theDeviceCa pabilityType)
Else
If myListCount > 0 Then
ReDim myIntegerArray( 0 To myListCount - 1)
L = DeviceCapabilit iesAny(thePrint er.DeviceName, thePrinter.Port ,
theDeviceCapabi lityType, myIntegerArray( 0), 0)
If L = -1 Then
errorLogWrite "Unable to retrieve list for " &
Str(theDeviceCa pabilityType)
End If
End If
End If

driverGetIntege rArray = myIntegerArray

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Function
Private Function driverGetPointV alue(ByVal theDeviceCapabi lityType As
mDeviceCapabili tyTypes, ByRef thePrinter As mPrinterStruct) As mXyPoint
callStackPush mModuleName, "driverGetPoint Value"
On Error GoTo catchError

' PURPOSE: To retrieve a single x/y pair of integers from a printer's driver
' ACCEPTS: - A constant telling what capability we are looking for. e.g. Bin
values
' - A printer struct containing name, port of printer
' RETURNS: An x/y coordinate value
'
' NOTES: 1) The DeviceCapabilit ies() API call returns -1 upon failure

Dim myPoint As mXyPoint
Dim L As Long

Dim myDoubleWord As mDoubleWordStru ct
Dim mySplitWord As mSplitWordStruc t
L = DeviceCapabilit iesLng(thePrint er.DeviceName, thePrinter.Port ,
theDeviceCapabi lityType, 0, 0)
If L = -1 Then
errorLogWrite "Unable to retrieve device capability for type" &
Str(theDeviceCa pabilityType)
End If

myDoubleWord.Va lue = L
LSet mySplitWord = myDoubleWord

myPoint.x = mySplitWord.LoW ord
myPoint.Y = mySplitWord.HiW ord

driverGetPointV alue = myPoint

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Function
Private Function isBool(ByVal theValue As Integer) As Boolean
callStackPush mModuleName, "isBool"
On Error GoTo catchError

' PURPOSE: To determine whether or not the value in question is a boolean
' ACCEPTS: The value
' RETURNS: True if boolean, else false

If Not IsNull(theValue ) Then
If IsNumeric(theVa lue) Then
If ((theValue = 0) Or (theValue = -1)) Then
isBool = True
End If
End If
End If

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Function
Private Function pdfFileNameCrea te(ByVal theGetFileNameF rom As Long, ByVal
theFileNamePref ix As String, ByVal theFileNameSuff ix As String, ByRef theReport
As Report) As String
callStackPush mModuleName, "pdfFileNameCre ate"
On Error GoTo catchError

' PURPOSE: To create the complet DOS path to the PDF file that Acrobat will
create
' ACCEPTS: - A code telling where to get file name from
' - An optional prefix for the file name
' - An optional suffix for the file name
' - A pointer to the report in question
'
' RETURNS: DOS path or empty string, depending upon success
' SETS: - mCurErrorCount (via 'errorListAdd')
' - mCurErrorList (via 'errorListAdd')

Dim myPdfFileName As String

Select Case theGetFileNameF rom
Case rpGetFromReport Name
myPdfFileName = theFileNamePref ix & theReport.Name & theFileNameSuff ix
Case rpGetFromReport Caption
With theReport
If Len(Trim$(.Capt ion & "")) > 0 Then
myPdfFileName = theFileNamePref ix & theReport.Capti on &
theFileNameSuff ix
Else
myPdfFileName = theFileNamePref ix & theReport.Name &
theFileNameSuff ix
End If
End With
Case Else
errorListAdd ".GetPdfFileNam eFrom: Values allowed: 1 = From Report Name,
2 = From Report's .Caption string. Value passed = " & Format$(theGetF ileNameFrom
& "", "#") & ". "
End Select

pdfFileNameCrea te = myPdfFileName

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Function
Private Function extractDirFromF ullPath(theFull Path) As String
callStackPush mModuleName, "extractDirFrom FullPath"
On Error GoTo catchError

' PURPOSE: To extract the directory portion (including final backslash)
' of a full path (i.e. one including file name....)
' ACCEPTS: The full path
' RETURNS: The directory portion of that path, including final backslash
'
' NOTES: It all hinges on the full path ending with a file name

Dim x As Integer
Dim Y As Integer
Dim L As Integer
Dim myDir As String

x = 1
Y = 999
L = Len(theFullPath )

Do While Y > 0
Y = InStr(x, theFullPath, "\")
If Y > 0 Then
L = Y
x = Y + 1
End If
Loop

extractDirFromF ullPath = Left$(theFullPa th, L - 1)

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
errorLogWrite ""
Resume Xit
End Function
Private Function extractDirFromF ullPath_elw(the FullPath) As String
On Error GoTo catchError 'NO ERROR LOGGING BECAUSE USED BY ERROR ROUTINES

' PURPOSE: To extract the directory portion (including final backslash)
' of a full path (i.e. one including file name....)
' ACCEPTS: The full path
' RETURNS: The directory portion of that path, including final backslash
'
' NOTES: 1) It all hinges on the full path ending with a file name
Dim x As Integer
Dim Y As Integer
Dim L As Integer
Dim myDir As String

x = 1
Y = 999
L = Len(theFullPath )

Do While Y > 0
Y = InStr(x, theFullPath, "\")
If Y > 0 Then
L = Y
x = Y + 1
End If
Loop

extractDirFromF ullPath_elw = Left$(theFullPa th, L - 1)

Xit:
callStackPop
On Error Resume Next
Exit Function

catchError:
MsgBox "clsReportPrint er: runtime error in extractDirFromF ullPath_elw()"
Resume Xit
End Function
Public Property Get Version() As String
callStackPush mModuleName, "Version"
On Error GoTo catchError

' PURPOSE: - To allow the current version number of this class
' RETURNS: String containing version number

Version = mVersionNumber

Xit:
callStackPop
On Error Resume Next
Exit Property

catchError:
errorLogWrite ""
Resume Xit
End Property
=============== =============== =============== =============== =============== =====
--
PeteCresswell
Nov 13 '05 #2
(Pete Cresswell)" <x@y.z> wrote in message
news:v2******** *************** *********@4ax.c om...

Assuming that all users have PdfWriter (couple hundred dollars per seat)
installed on their PC's, what you do is use the registry as your interface to Acrobat. You set parms for file name and a couple other things and then just let it rip.


Or, the excellent Win2PDF ($35 for commercial use, free for non-commercial).
It's FAQ page describes how to do what you want (with one line of code).
Nov 13 '05 #3
I had the same problem a long time ago and did manage to find the
solution. Hopefully Adobe haven't changed the ability to stop it
prompting for a filename, but they used to have something in win.ini
to allow you to switch this off and use a permanent name.

http://groups.google.com/groups?hl=e...%3D20%26sa%3DN

http://groups.google.com/groups?hl=e...%3D10%26sa%3DN

However, it looks like the solution has been moved (while the site is
updated), so you may need to track it down. Basically, the way I
(finally) fixed the problem was to print to a consistent file name
(using the PDF driver and setting Adobe not to prompt for a file name
e.g c:\myfile.pdf), and then renamed the file as I needed using
FileSystemObjec ts in VBA (this was several years ago mind) to whatever
I needed it to be. For my needs this did the trick. I don't have the
code any more unfortunately.

Sorry it's a bit vague, but it may point you towards a solution.

Ryan

do*********@hot mail.com (dog) wrote in message news:<d1******* *************** ***@posting.goo gle.com>...
I've seen plenty of articles on this topic but none of them have been
able to solve my problem.

I am working with an Access 97 database on an NT4.0 machine, which has
many Access reports.
I want my users to be able to select a report, click on a command
button on a form, which will then automatically create the report as a
pdf file and save it to the user's machine.

I am using Adobe Acrobat (5.0 I think) and have Adobe Distiller as a
printer. I can get my code to change my default printer to Adobe
Distiller, and using the Docmd.OutputTo, it will begin to create the
file.
However what then happens is: a ?Save File As' dialog box appears,
prompts me to click on ?OK' and when I do, the report is created and
saved, but Adobe then open the report. I want my code to be able to
override this dialog box and automatically save the report with a file
name I put in a variable, and stop Adobe from opening at the end.
I have looked at using the properties in Adobe but they don't seem to
help.

Is what I want to do possible? I don't know and unfortunately I work
for a large organisation and have to use Adobe and no other product ?
free or not.

I'm fairly new to VBA programming and messing with the registry is
beyond me so if anyone has any ideas, or better still has the code, it
would be much appreciated.

Many Thanks.

Nov 13 '05 #4
gj
FOr a good free PDF printer try PDFCREATOR at
http://sector7g.wurzel6.de/pdfcreator/index_en.htm

Make sure you install the latest patch.

GJ

Nov 13 '05 #5
dog
Thanks for all the suggestions but I still can't get it going.

I tried the above code but everytime it ran, the Adobe 'save as'
dialog box still came up, prompting me for a filename and then
launching adobe.

Maybe there is something wrong with the setup on the machines where I
work, but I tried it on 2 NT.4 workstations and had the same problem
on both???

Dog
ry********@hotm ail.com (Ryan) wrote in message news:<78******* *************** ****@posting.go ogle.com>...
I had the same problem a long time ago and did manage to find the
solution. Hopefully Adobe haven't changed the ability to stop it
prompting for a filename, but they used to have something in win.ini
to allow you to switch this off and use a permanent name.

http://groups.google.com/groups?hl=e...%3D20%26sa%3DN

http://groups.google.com/groups?hl=e...%3D10%26sa%3DN

However, it looks like the solution has been moved (while the site is
updated), so you may need to track it down. Basically, the way I
(finally) fixed the problem was to print to a consistent file name
(using the PDF driver and setting Adobe not to prompt for a file name
e.g c:\myfile.pdf), and then renamed the file as I needed using
FileSystemObjec ts in VBA (this was several years ago mind) to whatever
I needed it to be. For my needs this did the trick. I don't have the
code any more unfortunately.

Sorry it's a bit vague, but it may point you towards a solution.

Ryan

do*********@hot mail.com (dog) wrote in message news:<d1******* *************** ***@posting.goo gle.com>...
I've seen plenty of articles on this topic but none of them have been
able to solve my problem.

I am working with an Access 97 database on an NT4.0 machine, which has
many Access reports.
I want my users to be able to select a report, click on a command
button on a form, which will then automatically create the report as a
pdf file and save it to the user's machine.

I am using Adobe Acrobat (5.0 I think) and have Adobe Distiller as a
printer. I can get my code to change my default printer to Adobe
Distiller, and using the Docmd.OutputTo, it will begin to create the
file.
However what then happens is: a ?Save File As' dialog box appears,
prompts me to click on ?OK' and when I do, the report is created and
saved, but Adobe then open the report. I want my code to be able to
override this dialog box and automatically save the report with a file
name I put in a variable, and stop Adobe from opening at the end.
I have looked at using the properties in Adobe but they don't seem to
help.

Is what I want to do possible? I don't know and unfortunately I work
for a large organisation and have to use Adobe and no other product ?
free or not.

I'm fairly new to VBA programming and messing with the registry is
beyond me so if anyone has any ideas, or better still has the code, it
would be much appreciated.

Many Thanks.

Nov 13 '05 #6
I had a similar problem and figured out a solution using GhostScript,
RedMon and some Visual Basic automation with the FileSystemObjec t and
WScript.Network objects.

I posted the details of my approach here:
http://groups-beta.google.com/group/...1d9056438b0378
Regards,

CyranoVR at Gmail dot com

Nov 13 '05 #7
Also, the text formatting in my posting isn't that great thanks to my
inexperience with google groups. Here's a better-formatted version:
http://ourworld.cs.com/CyranoVR/autopdf.txt

Nov 13 '05 #8

This thread has been closed and replies have been disabled. Please start a new discussion.

Similar topics

0
3259
by: banderas | last post by:
Just wondering if it is possible to use access to create grpahs and even print reports? Is it possible to link excell with access so one can be the date base and when graphs and analytical reports are needed, I can call excell?
1
2656
by: intl04 | last post by:
I am getting strange print-related error messages when trying to create (not print!) reports. For example, when I click 'new' to create a report then choose 'design view', I get an error message that says: 'There was a problem retrieving printer information for this object. The object may have been sent to a printer that was unavailable.' When I choose 'report wizard', I can go through all of the steps but then I get an error message...
2
1919
by: Russell | last post by:
Hi, I have an asp.net web page using vb.net to code with. I have to create a report using pdf format to display online. can anyone help me with this. Thanks in advance Russell
2
3261
by: B.Newman | last post by:
I've got some VB.NET code that *should* get a list of reports from an Access MDB and populate a list box with them. It doesn't detect any of the reports at all. oAccess.Reports.Count comes up as 0. There are four reports in the MDB. They are not hidden. They don't have special characters in their names. There is no security on the MDB and no one else is accessing it. I have code currently to only show reports that start with "rpt_",...
0
2728
by: neoteny2 | last post by:
I need MS Access to automatically create reports/subreports based on specific criteria. I am building a database in Access 2003 with different locations/sites. I have the "sites" table created containing site info, including an empty field for "date". I also have a report format already created displaying the site info. I need Access to ask the user for a date, calculate three additional dates using the entered date (adding or subtracting...
2
35182
by: Shirley | last post by:
We are running DB2 on iSeries V5R2. Using AQUA DATA STUDIO with a connection to our iSeries, I created a view using SQL and I am trying to create an index on this view using the code below. CREATE INDEX reports.Ivendorname ON reports.transbyvendor05 (vendorname) However I get the following error:
0
2177
by: PughDR | last post by:
As the subject of this topic suggestions I am trying to find a way to use ASP, SQL Server, Com+ and Crystal Reports 8.5 to Create Dynamic PDF Reports Over The Web, but the only article I found that decribes this process is located on ASPToday.com which is no longer an active website. When I try and suscribe to the site I just get a message saying to email, and when I email I don't recieve a response. Anyway the article I am looking for...
3
18709
by: creative1 | last post by:
Here is how you create a complex data report that involves parent and child commands and you can update information at runtime. Its pretty straight forward to work with simple queries; however, working with complex reports is tricky Assumption: Reader of this article have basic knowledge of creating data reports. Creating a Parent-Child Command and create a DataReport Suppose we have a database called company with two tables ...
2
2779
by: nja2222 | last post by:
I would like to create a page for my clients to login and check for updates on their accounts. Then I would like to create a page where my employees can login and make updates, specifically new file uploads, to the clients accounts. I have seen similar sites everywhere, such as bank websites, USPS site, et cetera. What is required to accomplish this? I'm trying to do this with the PHP, MySQL and Adobe CS3 Master collection's 'Dreamweaver CS3' ...
0
8729
marktang
by: marktang | last post by:
ONU (Optical Network Unit) is one of the key components for providing high-speed Internet services. Its primary function is to act as an endpoint device located at the user's premises. However, people are often confused as to whether an ONU can Work As a Router. In this blog post, we’ll explore What is ONU, What Is Router, ONU & Router’s main usage, and What is the difference between ONU and Router. Let’s take a closer look ! Part I. Meaning of...
0
9217
Oralloy
by: Oralloy | last post by:
Hello folks, I am unable to find appropriate documentation on the type promotion of bit-fields when using the generalised comparison operator "<=>". The problem is that using the GNU compilers, it seems that the internal comparison operator "<=>" tries to promote arguments from unsigned to signed. This is as boiled down as I can make it. Here is my compilation command: g++-12 -std=c++20 -Wnarrowing bit_field.cpp Here is the code in...
0
8928
tracyyun
by: tracyyun | last post by:
Dear forum friends, With the development of smart home technology, a variety of wireless communication protocols have appeared on the market, such as Zigbee, Z-Wave, Wi-Fi, Bluetooth, etc. Each protocol has its own unique characteristics and advantages, but as a user who is planning to build a smart home system, I am a bit confused by the choice of these technologies. I'm particularly interested in Zigbee because I've heard it does some...
1
6563
isladogs
by: isladogs | last post by:
The next Access Europe User Group meeting will be on Wednesday 1 May 2024 starting at 18:00 UK time (6PM UTC+1) and finishing by 19:30 (7.30PM). In this session, we are pleased to welcome a new presenter, Adolph Dupré who will be discussing some powerful techniques for using class modules. He will explain when you may want to use classes instead of User Defined Types (UDT). For example, to manage the data in unbound forms. Adolph will...
0
4407
by: TSSRALBI | last post by:
Hello I'm a network technician in training and I need your help. I am currently learning how to create and manage the different types of VPNs and I have a question about LAN-to-LAN VPNs. The last exercise I practiced was to create a LAN-to-LAN VPN between two Pfsense firewalls, by using IPSEC protocols. I succeeded, with both firewalls in the same network. But I'm wondering if it's possible to do the same thing, with 2 Pfsense firewalls...
0
4660
by: adsilva | last post by:
A Windows Forms form does not have the event Unload, like VB6. What one acts like?
1
3094
by: 6302768590 | last post by:
Hai team i want code for transfer the data from one system to another through IP address by using C# our system has to for every 5mins then we have to update the data what the data is updated we have to send another system
2
2393
muto222
by: muto222 | last post by:
How can i add a mobile payment intergratation into php mysql website.
3
2031
bsmnconsultancy
by: bsmnconsultancy | last post by:
In today's digital era, a well-designed website is crucial for businesses looking to succeed. Whether you're a small business owner or a large corporation in Toronto, having a strong online presence can significantly impact your brand's success. BSMN Consultancy, a leader in Website Development in Toronto offers valuable insights into creating effective websites that not only look great but also perform exceptionally well. In this comprehensive...

By using Bytes.com and it's services, you agree to our Privacy Policy and Terms of Use.

To disable or enable advertisements and analytics tracking please visit the manage ads & tracking page.