Access VBA: Print copies of external files (1 Viewer)

J

jsdba

Registered User.
Local time
Today, 07:15
Joined
Jun 25, 2014
Messages
165
Hi access devs,

Can anyone help me modify the code below to print to a specific printer (not my default printer)?

Code: 
Private Declare PtrSafe Function apiShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) _
    As Long

'***App Window Constants***
Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MAX = 3            'Open Maximized
Public Const WIN_MIN = 2            'Open Minimized

'***Error Codes***
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&
Public Function fPrintFile(stFile As String)

' This function uses ShellExecute to print, rather than
' open, the file.

Dim lRet As Long, varTaskID As Variant
Dim stRet As String

lRet = apiShellExecute(hWndAccessApp, "print", _
        stFile, vbNullString, vbNullString, 0&)
        
If lRet > ERROR_SUCCESS Then
    stRet = vbNullString
    lRet = -1
Else
    Select Case lRet
        Case ERROR_NO_ASSOC:
            stRet = "Error: No associated application.  Could not print!"
        Case ERROR_OUT_OF_MEM:
            stRet = "Error: Out of Memory/Resources. Could not print!"
        Case ERROR_FILE_NOT_FOUND:
            stRet = "Error: File not found.  Could not print!"
        Case ERROR_PATH_NOT_FOUND:
            stRet = "Error: Path not found. Could not print!"
        Case ERROR_BAD_FORMAT:
            stRet = "Error:  Bad File Format. Could not print!"
        Case Else:
    End Select
End If
fPrintFile = lRet & _
            IIf(stRet = "", vbNullString, ", " & stRet)
End Function

Code: 
fPrintFile "C:\Users\username\Desktop\filename.pdf"
 
Ranman256

Ranman256

Well-known member
Local time
Today, 07:15
Joined
Apr 9, 2015
Messages
4,337
SetDefaultPrinter "printer2"
fPrintFile "C:\Users\username\Desktop\filename.pdf"
SetDefaultPrinter "printer1"



Code: 
'-----------
Function SetDefaultPrinter(strPrinterName As String) As Boolean
'-----------
   Dim strDeviceLine As String
   Dim strBuffer     As String
   Dim lngbuf        As Long
    
  ' get the full device string
  '
   strBuffer = Space(1024)
   lngbuf = GetProfileString("PrinterPorts", strPrinterName, "", strBuffer, Len(strBuffer))
  
  'Write out this new printer information in
  ' WIN.INI file for DEVICE item
  If lngbuf > 0 Then
     
     strDeviceLine = strPrinterName & "," & _
                     fstrDField(strBuffer, Chr(0), 1) & "," & _
                     fstrDField(strBuffer, Chr(0), 2)
                     
     Call WriteProfileString("windows", "Device", strDeviceLine)
     SetDefaultPrinter = True
     
     ' Below is optional, and should be done. It updates the existing windows
     ' so the "default" printer icon changes. If you don't do the below..then
     ' you will often see more than one printer as the default! The reason *not*
     ' to do the SendMessage is that many open applications will now sense the change
     ' in printer. I vote to leave it in..but your case you might not want this.
     '
     
     'Call SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, ByVal "windows")
    
  Else
     SetDefaultPrinter = False
  End If
       
End Function
 
Solo712

Solo712

Registered User.
Local time
Today, 07:15
Joined
Oct 19, 2012
Messages
828
jsdba said:
Hi access devs,

Can anyone help me modify the code below to print to a specific printer (not my default printer)?

Code: 
Private Declare PtrSafe Function apiShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) _
    As Long

'***App Window Constants***
Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MAX = 3            'Open Maximized
Public Const WIN_MIN = 2            'Open Minimized

'***Error Codes***
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&
Public Function fPrintFile(stFile As String)

' This function uses ShellExecute to print, rather than
' open, the file.

Dim lRet As Long, varTaskID As Variant
Dim stRet As String[COLOR="Red"], DefPrinter as String

'save the current default
DefPrinter= Application.Printer.DeviceName

' set a new default
Set Application.Printer = Application.Printers("MyColorPrinter")[/COLOR]

lRet = apiShellExecute(hWndAccessApp, "print", _
        stFile, vbNullString, vbNullString, 0&)
        
[COLOR="red"]'restore the default printer
Set Application.Printer = Application.Printers(DefPrinter)[/COLOR]

If lRet > ERROR_SUCCESS Then
    stRet = vbNullString
    lRet = -1
Else
    Select Case lRet
        Case ERROR_NO_ASSOC:
            stRet = "Error: No associated application.  Could not print!"
        Case ERROR_OUT_OF_MEM:
            stRet = "Error: Out of Memory/Resources. Could not print!"
        Case ERROR_FILE_NOT_FOUND:
            stRet = "Error: File not found.  Could not print!"
        Case ERROR_PATH_NOT_FOUND:
            stRet = "Error: Path not found. Could not print!"
        Case ERROR_BAD_FORMAT:
            stRet = "Error:  Bad File Format. Could not print!"
        Case Else:
    End Select
End If
fPrintFile = lRet & _
            IIf(stRet = "", vbNullString, ", " & stRet)
End Function

Code: 
fPrintFile "C:\Users\username\Desktop\filename.pdf"
Click to expand...

You can do it via Application.Printer/s without having to create another function. Add the code in red

Best,
Jiri
 
D

duke217

Registered User.
Local time
Today, 13:15
Joined
Jan 23, 2018
Messages
17
Hi,

Just came across these valuable pieces of code, which would accomplish exactly what I am trying to get access to do when clicking a button on a form.

I am guessing this code should go should go in the Button_Click() of the button (correct me if I am wrong):

Code: 
fPrintFile "C:\Users\username\Desktop\filename.pdf"

Okay, now the big piece should go where exactly? Should I create a module, or put it in the Form_Load() of my form? Or somewhere else?

Code: 
Private Declare PtrSafe Function apiShellExecute Lib "shell32.dll" _
    Alias "ShellExecuteA" _
    (ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) _
    As Long

'***App Window Constants***
Public Const WIN_NORMAL = 1         'Open Normal
Public Const WIN_MAX = 3            'Open Maximized
Public Const WIN_MIN = 2            'Open Minimized

'***Error Codes***
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&
Public Function fPrintFile(stFile As String)

' This function uses ShellExecute to print, rather than
' open, the file.

Dim lRet As Long, varTaskID As Variant
Dim stRet As String, DefPrinter as String

'save the current default
DefPrinter= Application.Printer.DeviceName

' set a new default
Set Application.Printer = Application.Printers("MyColorPrinter")

lRet = apiShellExecute(hWndAccessApp, "print", _
        stFile, vbNullString, vbNullString, 0&)
        
'restore the default printer
Set Application.Printer = Application.Printers(DefPrinter)

If lRet > ERROR_SUCCESS Then
    stRet = vbNullString
    lRet = -1
Else
    Select Case lRet
        Case ERROR_NO_ASSOC:
            stRet = "Error: No associated application.  Could not print!"
        Case ERROR_OUT_OF_MEM:
            stRet = "Error: Out of Memory/Resources. Could not print!"
        Case ERROR_FILE_NOT_FOUND:
            stRet = "Error: File not found.  Could not print!"
        Case ERROR_PATH_NOT_FOUND:
            stRet = "Error: Path not found. Could not print!"
        Case ERROR_BAD_FORMAT:
            stRet = "Error:  Bad File Format. Could not print!"
        Case Else:
    End Select
End If
fPrintFile = lRet & _
            IIf(stRet = "", vbNullString, ", " & stRet)
End Function
 
You must log in or register to reply here.

Similar threads

H
FTP blocking
Replies
6
Views
386
JaimeHeller
J
H
FTP to Upload documents
Replies
7
Views
640
Harris@Z
H
S
Solved MS Access Navigationform moveable
Replies
1
Views
292
isladogs
isladogs
G
Password masked inputbox
Replies
3
Views
665
isladogs
isladogs
R
  • Question
Save the names of tables, forms, and reports in a Microsoft Access database to a table named "ObjectNames.
2
Replies
32
Views
929
spaLOGICng
S

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom