oh, i forgot to include that.
Just put this in a new module.
Option Compare Database
Option Explicit
' Declaration for the DeviceCapabilities function API call.
Private Declare Function DeviceCapabilities Lib "winspool.drv" _
Alias "DeviceCapabilitiesA" (ByVal lpsDeviceName As String, _
ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _
ByVal lpDevMode As Long) As Long
' DeviceCapabilities function constants.
Private Const DC_PAPERNAMES = 16
Private Const DC_PAPERS = 2
Private Const DC_BINNAMES = 12
Private Const DC_BINS = 6
Private Const DEFAULT_VALUES = 0
Public Sub ShowPrinters()
Dim strCount As String
Dim strMsg As String
Dim prtLoop As Printer
'on error goTo ShowPrinters_Err
If Printers.Count > 0 Then
' Get count of installed printers.
strMsg = "Printers installed: " & Printers.Count & vbCrLf & vbCrLf
' Enumerate printer system properties.
For Each prtLoop In Application.Printers
With prtLoop
strMsg = strMsg _
& "Device name: " & .DeviceName & vbCrLf _
& "Driver name: " & .DriverName & vbCrLf _
& "Port: " & .Port & vbCrLf & vbCrLf
End With
Next prtLoop
Else
strMsg = "No printers are installed."
End If
' Display printer information
' AccessMsgBox err.Description, err.Number
ShowPrinters_End:
Exit Sub
ShowPrinters_Err:
' AccessMsgBox Prompt:=Err.Description, Buttons:=vbCritical & vbOKOnly, _
' Title:="Error Number " & Err.Number & " Occurred"
' AccessMsgBox err.Description, err.Number
Resume ShowPrinters_End
End Sub
Public Sub ChangeBins()
Dim strReportName As String
Dim prt As Printer
'on error goTo ChangeBins_Err
strReportName = "Alphabetical List Of Products"
'Open the report in print preview
DoCmd.OpenReport reportname:=strReportName, View:=acViewPreview
' Get the Printer object for the report.
Set prt = Reports(strReportName).Printer
' Change the PaperBin property to print from the lower bin.
prt.PaperBin = acPRBNLower
' Use the PrintOut method to print only the first page of the report.
DoCmd.PrintOut PrintRange:=acPages, PageFrom:=1, PageTo:=1
' Change the PaperBin property to print from the upper bin.
prt.PaperBin = acPRBNUpper
' Use the PrintOut method to print the remainder of the report by
' specifying 2 for the PageFrom argument and 32767 for the PageTo
' argument. Because 32767 is the maximum number of pages that can be
' printed, all remaining pages will be printed.
DoCmd.PrintOut PrintRange:=acPages, PageFrom:=2, PageTo:=32767
' Close report without saving changes.
DoCmd.Close ObjectType:=acReport, ObjectName:=strReportName, Save:=acSaveNo
ChangeBins_End:
Exit Sub
ChangeBins_Err:
' AccessMsgBox prompt:=err.Description, Buttons:=vbCritical & vbOKOnly, _
Title:="Error Number " & err.Number & " Occurred"
' AccessMsgBox err.Description, err.Number
Resume ChangeBins_End
End Sub
Function GetPaperSize(frmName As Form) As AcPrintPaperSize
' Check the string in the cboPaperSize box, and
' pass back the corresponding AcPrintPaperSize
' constant.
Select Case frmName!cboPaperSize
Case "Letter"
GetPaperSize = acPRPSLetter
Case "Legal"
GetPaperSize = acPRPSLegal
Case "Statement"
GetPaperSize = acPRPSStatement
Case "Executive"
GetPaperSize = acPRPSExecutive
End Select
End Function
Public Function GetPaperBin(frmName As Form) As AcPrintPaperBin
' Check the string in the cboPaperBin box, and
' pass back the corresponding AcPrintPaperBin
' constant.
Select Case frmName!cboPaperBin
Case "Default"
GetPaperBin = acPRBNAuto
Case "Upper"
GetPaperBin = acPRBNUpper
Case "Middle"
GetPaperBin = acPRBNMiddle
Case "Lower"
GetPaperBin = acPRBNLower
End Select
End Function
Public Sub PrintReport(StrPrinter As String, strReportName As String)
Dim prtApp As Printer
'on error goTo PrintReport_Err
' Get selected printer and set user-specified settings
Set prtApp = Application.Printers(StrPrinter)
Reports(strReportName).Printer = prtApp
DoCmd.PrintOut PrintRange:=acPrintAll
PrintReport_End:
Exit Sub
PrintReport_Err:
' AccessMsgBox err.Description, vbCritical & vbOKOnly, _
"Error Number " & err.Number & " Occurred"
' AccessMsgBox Err.Description, Err.Number
Resume PrintReport_End
End Sub
Sub GetPaperList()
' Uses DeviceCapabilities API function to display a message box
' with the name of the default printer and a list of
' the papers it supports.
Dim lngPaperCount As Long
Dim lngCounter As Long
Dim hPrinter As Long
Dim strDeviceName As String
Dim strDevicePort As String
Dim strPaperNamesList As String
Dim strPaperName As String
Dim intLength As Integer
Dim strMsg As String
Dim aintNumPaper() As Integer
'on error goTo GetPaperList_Err
' Get the name and port of the default printer.
strDeviceName = Application.Printer.DeviceName
strDevicePort = Application.Printer.Port
' Get the count of paper names supported by printer.
lngPaperCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
lpPort:=strDevicePort, _
iIndex:=DC_PAPERNAMES, _
lpOutput:=ByVal vbNullString, _
lpDevMode:=DEFAULT_VALUES)
' Re-dimension the array to the count of paper names.
ReDim aintNumPaper(1 To lngPaperCount)
' Pad the variable to accept 64 bytes for each paper name.
strPaperNamesList = String(64 * lngPaperCount, 0)
' Get the string buffer of all paper names supported by the printer.
lngPaperCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
lpPort:=strDevicePort, _
iIndex:=DC_PAPERNAMES, _
lpOutput:=ByVal strPaperNamesList, _
lpDevMode:=DEFAULT_VALUES)
' Get the array of all paper numbers supported by the printer.
lngPaperCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
lpPort:=strDevicePort, _
iIndex:=DC_PAPERS, _
lpOutput:=aintNumPaper(1), _
lpDevMode:=DEFAULT_VALUES)
' List the available paper names.
strMsg = "Papers available for " & strDeviceName & vbCrLf
For lngCounter = 1 To lngPaperCount
' Parse a paper name from the string buffer.
strPaperName = Mid(String:=strPaperNamesList, _
Start:=64 * (lngCounter - 1) + 1, Length:=64)
intLength = VBA.InStr(Start:=1, String1:=strPaperName, String2:=Chr(0)) - 1
strPaperName = Left(String:=strPaperName, Length:=intLength)
' Add a paper number and name to text string for the message box.
strMsg = strMsg & vbCrLf & aintNumPaper(lngCounter) _
& vbTab & strPaperName
Next lngCounter
' Show the paper names in a message box.
AccessMsgBox err.Description, err.Number
GetPaperList_End:
Exit Sub
GetPaperList_Err:
' AccessMsgBox prompt:=err.Description, Buttons:=vbCritical & vbOKOnly, _
Title:="Error Number " & err.Number & " Occurred"
' AccessMsgBox Err.Description, Err.Number
Resume GetPaperList_End
End Sub
Sub GetBinList(strName As String)
' Uses the DeviceCapabilities API function to display a
' message box with the name of the default printer and a
' list of the paper bins it supports.
Dim lngBinCount As Long
Dim lngCounter As Long
Dim hPrinter As Long
Dim strDeviceName As String
Dim strDevicePort As String
Dim strBinNamesList As String
Dim strBinName As String
Dim intLength As Integer
Dim strMsg As String
Dim aintNumBin() As Integer
'on error goTo GetBinList_Err
' Get name and port of the default printer.
strDeviceName = Application.Printers(strName).DeviceName
strDevicePort = Application.Printers(strName).Port
' Get count of paper bin names supported by printer.
lngBinCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
lpPort:=strDevicePort, _
iIndex:=DC_BINNAMES, _
lpOutput:=ByVal vbNullString, _
lpDevMode:=DEFAULT_VALUES)
' Re-dimension array to count of paper bins.
ReDim aintNumBin(1 To lngBinCount)
' Pad variable to accept 24 bytes for each bin name.
strBinNamesList = String(Number:=24 * lngBinCount, Character:=0)
' Get string buffer of paper bin names supported by printer.
lngBinCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
lpPort:=strDevicePort, _
iIndex:=DC_BINNAMES, _
lpOutput:=ByVal strBinNamesList, _
lpDevMode:=DEFAULT_VALUES)
' Get array of paper bin numbers supported by printer
lngBinCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
lpPort:=strDevicePort, _
iIndex:=DC_BINS, _
lpOutput:=aintNumBin(1), _
lpDevMode:=0)
' List available paper bin names.
strMsg = "Paper bins available for " & strDeviceName & vbCrLf
For lngCounter = 1 To lngBinCount
' Parse a paper bin name from string buffer.
strBinName = Mid(String:=strBinNamesList, _
Start:=24 * (lngCounter - 1) + 1, _
Length:=24)
intLength = VBA.InStr(Start:=1, _
String1:=strBinName, String2:=Chr(0)) - 1
strBinName = Left(String:=strBinName, _
Length:=intLength)
' Add bin name and number to text string for message box.
strMsg = strMsg & vbCrLf & aintNumBin(lngCounter) _
& vbTab & strBinName
Next lngCounter
' Show paper bin numbers and names in message box.
'AccessMsgBox Prompt:=strMsg
'AccessMsgBox Err.Description, Err.Number
GetBinList_End:
Exit Sub
GetBinList_Err:
' AccessMsgBox Err.Description, Err.Number
' AccessMsgBox prompt:=err.Description, Buttons:=vbCritical & vbOKOnly, _
Title:="Error Number " & err.Number & " Occurred"
Resume GetBinList_End
End Sub
Sub ClearReportSettings()
Dim obj As AccessObject
'on error goTo ClearReportSettings_Err
' Open each report in the current project, and
' if the report is not using the default printer,
' reset its UseDefaultPrinter property to True.
For Each obj In CurrentProject.AllReports
DoCmd.OpenReport reportname:=obj.name, View:=acViewDesign
If Not Reports(obj.name).UseDefaultPrinter Then
Reports(obj.name).UseDefaultPrinter = True
DoCmd.Save ObjectType:=acReport, ObjectName:=obj.name
End If
DoCmd.Close
DoEvents
Next
AccessMsgBox err.Description, err.Number
ClearReportSettings_End:
Exit Sub
ClearReportSettings_Err:
'AccessMsgBox Err.Description, Err.Number
' AccessMsgBox prompt:=err.Description, Buttons:=vbCritical & vbOKOnly, _
Title:="Error Number " & err.Number & " Occurred"
Resume ClearReportSettings_End
End Sub
Mark P.
Providing Low Cost Powerful Point of Sale Solutions.
