Can Access Change the Default Printer? 1

[markphsd]

I would like to know if, and how, to change the default printer of Windows with VBA.

I have reports written for POS printers, before I distribute them I would like to make sure they are reset to the default printer, which would be POS Printer. However, I also have reports written for regular 8 1/2" X 11 paper and I would like to make sure they are reset to the normal size paper.

So, I would like to be able to reset all reports for the correct printer, without having to go to the printer control panel. If i could change the default printer in code I could accomplish my plan.

Thanks for any assistance.

Mark P.

http://www.cafecartel.com

Providing Low Cost Powerful Point of Sale Solutions.

 

[CautionMP]

markphsd,
This doesn't answer your question but might solve your problem.

If you go to the Page setup for each report (File=>Page Setup...), on the Page tab the last section is Printer for ReportName. Select the Radio Button for Use Specific Printer and then selct the printer you want to use.

This setting should work on a report by report basis so you can send reports 1 & 2 to Printer1, reports 3 & 4 to Printer2, as reports 5 - xx to the users default printer.

Hope this helps.

_{P.S. At one point there was a bug in Access that if you had one of the AutoCorrect options enabled in the global settings it would mess with your print settings (printer, margins, paper size...) I mention this jsut in case it has never been fixed.}

 

[markphsd]

Thanks CautionMP,

I'm looking for something to automate it. With your method I would have to manually walk through about 50 or 60 reports before each packaging. That would be too hard.

Autocorrect is off.

If i were to set reports to specific printers, then all users of my distribution would have to have those printers. That end up to be a bad idea is distributions.

Thanks for your thoughts though

Mark P.

http://www.cafecartel.com

Providing Low Cost Powerful Point of Sale Solutions.

 

[alfalf]

Yes, You can do that. There's some coding though, which inludes API calls. I have it in my application. Will put it here the moment I get time, that will be somewhere today.

Just to keep you informed for now.

 

[markphsd]

alfalf,

awesome, thanks.



Mark P.

http://www.cafecartel.com

Providing Low Cost Powerful Point of Sale Solutions.

 

[alfalf]

Sorry, had a bit rough day.

Code provided not only changes default printer on system, but also invokes printer settings dialog.

1. Make Module (call it whatever) and put this code in it:

Option Compare Database
Option Explicit

'******************************************************
'Ändern des Standarddruckers mit API-Funktionen (32-bit)
'Die Informationen in diesem Artikel beziehen sich auf:
'
'Microsoft Visual Basic, Version 4.0, 5.0, 6.0
'
'Frage:
'
'Ich habe Probleme, den Standarddrucker mit dem in Microsoft Visual Basic,
'enthaltenen Printer Objekt zu ändern. Wie kann ich Abhilfe schaffen?
'
'Antwort:
'
'Es kann vorkommen, daß Änderungen des Standarddruckers im Printer Objekt
'ignoriert werden, so daß Ausdrucke mit der Methode Printer.Print immer auf den
'selben Drucker geroutet werden. Abhilfe schafft hier der Einsatz von
'API-Funktionen zum Ändern des Standarddruckers.
'
'Folgendes Beispiel zeigt auf, wie man alle verfügbaren Drucker auflistet und
'dann einen als Standarddrucker festlegt.
'
'Bitte beachten Sie:
'Diese Vorgehensweise ändert den Standarddrucker aller laufenden Applikationen.
'
'1. Fügen Sie folgenden Code in ein Modul ein:
'******************************************************

Declare Function GetProfileString Lib "kernel32" _
Alias "GetProfileStringA" _
(ByVal lpAppName As String, _
ByVal lpKeyName As String, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long) As Long

Declare Function WriteProfileString Lib "kernel32" _
Alias "WriteProfileStringA" _
(ByVal lpszSection As String, _
ByVal lpszKeyName As String, _
ByVal lpszString As String) As Long

Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As String) As Long

Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Public Const HWND_BROADCAST = &HFFFF
Public Const WM_WININICHANGE = &H1A

Public Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type

Declare Function GetVersionExA Lib "kernel32" _
(lpVersionInformation As OSVERSIONINFO) As Integer

Public Declare Function OpenPrinter Lib "winspool.drv" _
Alias "OpenPrinterA" _
(ByVal pPrinterName As String, _
phPrinter As Long, _
pDefault As PRINTER_DEFAULTS) As Long

Public Declare Function SetPrinter Lib "winspool.drv" _
Alias "SetPrinterA" _
(ByVal hPrinter As Long, _
ByVal Level As Long, _
pPrinter As Any, _
ByVal Command As Long) As Long

Public Declare Function GetPrinter Lib "winspool.drv" _
Alias "GetPrinterA" _
(ByVal hPrinter As Long, _
ByVal Level As Long, _
pPrinter As Any, _
ByVal cbBuf As Long, _
pcbNeeded As Long) As Long

Public Declare Function ClosePrinter Lib "winspool.drv" _
(ByVal hPrinter As Long) As Long

Declare Function PrinterProperties Lib "winspool.drv" _
 (ByVal hwnd As Long, ByVal hPrinter As Long) As Long

Public Declare Function GetLastError Lib "kernel32" () As Long

Declare Function DocumentProperties Lib "winspool.drv" Alias _
"DocumentPropertiesA" (ByVal hwnd As Long, ByVal hPrinter As Long, _
ByVal pDeviceName As String, pDevModeOutput As DEVMODE, pDevModeInput As _
DEVMODE, ByVal fMode As Long) As Long

Declare Function lstrcpyn Lib "kernel32" Alias "lstrcpynA" (lpString1 As Any, lpString2 _
As Any, ByVal count As Long) As Long

' Konstanten der DEVMODE Struktur
Public Const CCHDEVICENAME = 32
Public Const CCHFORMNAME = 32

' Konstanten der DesiredAccess member der PRINTER_DEFAULTS
Public Const STANDARD_RIGHTS_REQUIRED = &HF0000
Public Const PRINTER_ACCESS_ADMINISTER = &H4
Public Const PRINTER_ACCESS_USE = &H8
Public Const PRINTER_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
PRINTER_ACCESS_ADMINISTER Or PRINTER_ACCESS_USE)

' Konstanten der PRINTER_INFO_5 Attributes member
' standardmäßig setzen
Public Const PRINTER_ATTRIBUTE_DEFAULT = 4

Public Type DEVMODE
    dmDeviceName As String * CCHDEVICENAME
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As String * CCHFORMNAME
    dmLogPixels As Integer
    dmBitsPerPel As Long
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
    dmICMMethod As Long ' // Windows 95 only
    dmICMIntent As Long ' // Windows 95 only
    dmMediaType As Long ' // Windows 95 only
    dmDitherType As Long ' // Windows 95 only
    dmReserved1 As Long ' // Windows 95 only
    dmReserved2 As Long ' // Windows 95 only
End Type

Public Type PRINTER_INFO_5
    pPrinterName As String
    pPortName As String
    Attributes As Long
    DeviceNotSelectedTimeout As Long
    TransmissionRetryTimeout As Long
End Type

Public Type PRINTER_DEFAULTS
    pDatatype As Long
'    pDevMode As DEVMODE
    pDevMode As Long
    DesiredAccess As Long
End Type

Public Type PRINTER_INFO_2
    pServerName As String
    pPrinterName As String
    pShareName As String
    pPortName As String
    pDriverName As String
    pComment As String
    pLocation As String
    ' Achtung: pDevmode muss als Long dimensioniert sein
    pDevMode As Long
    pSepFile As String
    pPrintProcessor As String
    pDatatype As String
    pParameters As String
    ' Achtung: pSecurityDescriptor muss als Long dimensioniert sein
    pSecurityDescriptor As Long
    Attributes As Long
    Priority As Long
    DefaultPriority As Long
    StartTime As Long
    UntilTime As Long
    Status As Long
    cJobs As Long
    AveragePPM As Long
End Type

Public Const DM_MODIFY = 8
Public Const DM_IN_BUFFER = DM_MODIFY
Public Const DM_COPY = 2
Public Const DM_OUT_BUFFER = DM_COPY

Public Const DMBIN_ENVELOPE = 5
Public Const DMBIN_AUTO = 7
Public Const DMBIN_CASSETTE = 14
Public Const DMBIN_ENVMANUAL = 6
Public Const DMBIN_LARGECAPACITY = 11
Public Const DMBIN_LARGEFMT = 10
Public Const DMBIN_LOWER = 2
Public Const DMBIN_MANUAL = 4
Public Const DMBIN_MIDDLE = 3
Public Const DMBIN_ONLYONE = 1
Public Const DMBIN_SMALLFMT = 9
Public Const DMBIN_TRACTOR = 8
Public Const DMBIN_UPPER = 1

Public Const DM_DEFAULTSOURCE = &H200&
Public Const DM_PROMPT = 4
Public Const DM_IN_PROMPT = DM_PROMPT
Public Const DMORIENT_LANDSCAPE = 2


Declare Function WritePrivateProfileString Lib _
        "kernel32" Alias "WritePrivateProfileStringA" _
        (ByVal lpApplicationName As String, ByVal lpKeyName _
        As Any, ByVal lpString As Any, ByVal lpFileName As _
        String) As Long

'32 bit
Declare Function GetPrivateProfileString Lib "kernel32" _
        Alias "GetPrivateProfileStringA" (ByVal lpApplicationName _
        As String, ByVal lpKeyName As Any, ByVal lpDefault As _
        String, ByVal lpReturnedString As String, ByVal nSize As _
        Long, ByVal lpFileName As String) As Long

2. Make an Dialog (call it whatever) and on it put:
- List (row source type - value list), call it List1;
- Text box, call it DefPrint;
- Command button, call it SetDefault
- Command button, call it Settings.

3. Paste this code into form code:

Option Compare Database
Option Explicit

'Verwendet mdlPrinterDefault
'Verwendet mdlINIDatei

Private Const LOWERLIMIT As Long = -32768
Private Const UPPERLIMIT As Long = 32767

Private Declare Function lstrcpy Lib "kernel32" (ByVal lpString1 As Any, ByVal lpString2 As Any) As Long

Private Sub SetDefault_Click()

Dim OSInfo As OSVERSIONINFO
Dim retValue As Integer
Dim x As String
Dim r As Long

OSInfo.dwOSVersionInfoSize = 148
OSInfo.szCSDVersion = Space$(128)
retValue = GetVersionExA(OSInfo)

If OSInfo.dwMajorVersion = 3 And OSInfo.dwMinorVersion = 51 And _
OSInfo.dwPlatformId = 2 Then
    If MsgBox("Change Deafult Printer / Fax to '" & Me!List1 & "'." & vbCrLf & vbCrLf & _
    "Are You sure?" & vbCrLf & vbCrLf & "By changing Default Printer / Fax here, " & _
    "You change it on the System.", (vbYesNo + vbQuestion), "Win NT 3.51 Printer Change") = vbYes Then
        DoCmd.Hourglass (True)
        Call WinNTSetDefaultPrinter(Me!List1)
        
        x = GetProfile("win.ini", "Windows", "Device")
        
        r = InStr(1, x, ",")
        If r > 0 Then
            x = Left(x, r - 1)
        End If
        
        Me!DefPrint = x
        If IsLoaded("Print") Then
        Forms!Print!DefPrint = " " & x
        End If
        If IsLoaded("TC") Then
        Forms!TC!DefPrint = " " & x
        End If
    Else
        Exit Sub
    End If
ElseIf OSInfo.dwMajorVersion = 4 _
And OSInfo.dwPlatformId = 1 Then
    If MsgBox("Change Deafult Printer / Fax to '" & Me!List1 & "'." & vbCrLf & vbCrLf & _
    "Are You sure?" & vbCrLf & vbCrLf & "By changing Default Printer / Fax here, " & _
    "You change it on the System.", (vbYesNo + vbQuestion), "Win 95 / 98 Printer Change") = vbYes Then
        DoCmd.Hourglass (True)
        Call Win95SetDefaultPrinter(Me!List1)
        x = GetProfile("win.ini", "Windows", "Device")
        
        r = InStr(1, x, ",")
        If r > 0 Then
            x = Left(x, r - 1)
        End If
        
        Me!DefPrint = x
        If IsLoaded("Print") Then
        Forms!Print!DefPrint = " " & x
        End If
        If IsLoaded("TC") Then
        Forms!TC!DefPrint = " " & x
        End If

    Else
        Exit Sub
    End If
ElseIf OSInfo.dwMajorVersion >= 4 And OSInfo.dwMinorVersion >= 0 _
And OSInfo.dwPlatformId = 2 Then
    If MsgBox("Change Deafult Printer / Fax to '" & Me!List1 & "'." & vbCrLf & vbCrLf & _
    "Are You sure?" & vbCrLf & vbCrLf & "By changing Default Printer / Fax here, " & _
    "You change it on the System.", (vbYesNo + vbQuestion), "Win NT 4 / 2000 Printer Change") = vbYes Then
        DoCmd.Hourglass (True)
        Call WinNTSetDefaultPrinter(Me!List1)
        x = GetProfile("win.ini", "Windows", "Device")
        
        r = InStr(1, x, ",")
        If r > 0 Then
            x = Left(x, r - 1)
        End If
        
        Me!DefPrint = " " & x
        If IsLoaded("Print") Then
        Forms!Print!DefPrint = " " & x
        End If
        If IsLoaded("TC") Then
        Forms!TC!DefPrint = " " & x
        End If

    Else
        Exit Sub
    End If
End If
End Sub

Private Sub Settings_Click()
On Error GoTo err_list1_click

            Dim xxnam As String
            Dim PD As PRINTER_DEFAULTS
            Dim RetVal As Long, hPrinter As Long
            
            PD.pDatatype = 0
            PD.DesiredAccess = PRINTER_ALL_ACCESS
            PD.pDevMode = 0
            xxnam = Trim(Me!DefPrint.Value)
            
            RetVal = OpenPrinter(xxnam, hPrinter, PD)
            If RetVal = 0 Then
                MsgBox "Open Printer Settings: Unsuccessfully!"
            Else
                RetVal = PrinterProperties(hWndAccessApp, hPrinter)
                RetVal = ClosePrinter(hPrinter)
            End If
End Sub

Private Sub Form_Load()

If Me.List1 <> Trim(Me.DefPrint) Then
Me.SetDefault.Enabled = True
Else
Me.SetDefault.Enabled = False
End If

Dim r As Long
Dim Buffer As String, x As String

'Dieser Code füllt die Listbox mit allen verfügbaren Druckern. Der Anwender
'kann per Doppelklick einen Drucker auswählen und zum Standarddrucker machen.

'Get the list of available printers from WIN.INI
Buffer = Space(8192)
r = GetProfileString("PrinterPorts", vbNullString, "", Buffer, Len(Buffer))

'Display the list of printer in the list box List1
'ParseList Me!List1, Buffer

Buffer = Trim(Buffer)

x = ParseList(Buffer)

Me!List1.RowSource = x

x = GetProfile("win.ini", "Windows", "Device")

r = InStr(1, x, ",")
If r > 0 Then
    x = Left(x, r - 1)
End If

Me.DefPrint = " " & x

Me.List1 = x

End Sub

Private Function ParseList(ByVal Buffer As String) As String
Dim i As Integer, ZStr As String
ParseList = ""

Do While (Right(Buffer, 1) = Chr(0) Or Right(Buffer, 1) = " " Or Right(Buffer, 1) = ";")
    Buffer = Left(Buffer, Len(Buffer) - 1)
Loop

Do
    i = InStr(Buffer, Chr(0))
    ZStr = ""
    If i > 0 Then
        ZStr = Left(Buffer, i - 1)
        Buffer = Mid(Buffer, i + 1)
    Else
        ZStr = Buffer
        Buffer = ""
    End If
    
    If Len(ParseList) > 0 Then
        ParseList = ParseList & ";" & ZStr
    Else
        ParseList = ZStr
    End If
Loop While i > 0
End Function


Private Sub List1_Click()

If Me.List1 <> Trim(Me.DefPrint) Then
Me.Command7.Enabled = True
Else
Me.Command7.Enabled = False
End If

End Sub

Private Sub Win95SetDefaultPrinter(Druckername As String)
Dim handle As Long 'Drucker Handle
Dim PrinterName As String
Dim PD As PRINTER_DEFAULTS
Dim x As Long
Dim need As Long ' benötigte Bytes
Dim pi5 As PRINTER_INFO_5 ' eigene PRINTER_INFO Struktur
Dim LastError As Long

' ausgewählten Drucker bestimmen
'PrinterName = List1.List(List1.ListIndex)
PrinterName = Druckername
' none - exit
If PrinterName = "" Then
Exit Sub
End If

' PRINTER_DEFAULTS members setzen
PD.pDatatype = 0&
PD.DesiredAccess = PRINTER_ALL_ACCESS

' Drucker Handle bestimmen
x = OpenPrinter(PrinterName, handle, PD)
' failed the open
If x = False Then
'Error Handler Code wird hier plaziert
Exit Sub
End If

' Aufruf von GetPrinter() zum Vorbereiten von (PRINTER_INFO_5) Information
' um die Anzahl der benötigten Bytes zu bestimmen
x = GetPrinter(handle, 5, ByVal 0&, 0, need)
'GetLastError() Aufrufe schlagen hier fehl mit
' 122 - ERROR_INSUFFICIENT_BUFFER

ReDim t((need \ 4)) As Long

' zweiter administrativer Aufruf von GetPrinter
x = GetPrinter(handle, 5, t(0), need, need)
' auf Gültigkeit überprüfen
If x = False Then
'Error Handler Code wird hier plaziert
Exit Sub
End If

'Struktur schreiben um SetPrinter erfolgreich auszuführen.
' PtrCtoVbString kopiert den Inhalt des Speichers der beiden
' String Pointer des t() arrays in einen Visual Basic String.
' Die anderen 3 Elemente sind einfache DWORDS (Long Integer)
' und benötigen dementsprechend keine Konvertierung.
pi5.pPrinterName = PtrCtoVbString(t(0))
pi5.pPortName = PtrCtoVbString(t(1))
pi5.Attributes = t(2)
pi5.DeviceNotSelectedTimeout = t(3)
pi5.TransmissionRetryTimeout = t(4)

' Flag für Standarddrucker setzen
pi5.Attributes = PRINTER_ATTRIBUTE_DEFAULT

' call SetPrinter to set it
x = SetPrinter(handle, 5, pi5, 0)
' Ausführung überprüfen
If x = False Then
MsgBox "SetPrinterFailed. Error code: " & GetLastError()
Exit Sub
End If

' Handle wieder schließen
ClosePrinter (handle)

End Sub

Private Sub WinNTSetDefaultPrinter(Druckername As String)
Dim Buffer As String
Dim DeviceName As String
Dim DriverName As String
Dim PrinterPort As String
Dim PrinterName As String
Dim r As Long
'If List1.ListIndex > -1 Then
If Len(Nz(Druckername)) > 0 Then

    'Druckerinformationen des aktuellen Standarddruckers
    'aus der WIN.INI bestimmen
    Buffer = Space(1024)
'    PrinterName = List1.Text
    PrinterName = Druckername
    r = GetProfileString("PrinterPorts", PrinterName, "", _
    Buffer, Len(Buffer))
    
    'Treibernamen und Anschluß aus Puffer parsen
    GetDriverAndPort Buffer, DriverName, PrinterPort
    
    If DriverName <> "" And PrinterPort <> "" Then
        SetDefaultPrinter Druckername, DriverName, PrinterPort
    End If
End If
End Sub

Private Function PtrCtoVbString(Add As Long) As String

Dim sTemp As String * 512, x As Long

x = lstrcpy(sTemp, Add)
If (InStr(1, sTemp, Chr(0)) = 0) Then
    PtrCtoVbString = ""
Else
    PtrCtoVbString = Left(sTemp, InStr(1, sTemp, Chr(0)) - 1)
End If

End Function

Private Sub SetDefaultPrinter(ByVal PrinterName As String, _
ByVal DriverName As String, ByVal PrinterPort As String)
Dim DeviceLine As String
Dim r As Long
Dim L As Long
DeviceLine = PrinterName & "," & DriverName & "," & PrinterPort
' Neue Drucker Informationen im [WINDOWS] Abschnitt der WIN.INI speichern
r = WriteProfileString("windows", "Device", DeviceLine)
' Alle Applikationen müssen die WIN.INI neu einlesen:
L = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, "windows")
End Sub

Private Sub GetDriverAndPort(ByVal Buffer As String, DriverName As String, _
PrinterPort As String)
On Error GoTo err_list1_click

Dim iDriver As Integer
Dim iPort As Integer
DriverName = ""
PrinterPort = ""

'Der Treibername steht am Anfang des "Komma"-terminierten Strings
iDriver = InStr(Buffer, ",")
If iDriver > 0 Then

    'Treibernamen extrahieren
    DriverName = Left(Buffer, iDriver - 1)
    
    'Nach dem Treibernamen folgt der Anschluß
    iPort = InStr(iDriver + 1, Buffer, ",")
    
    If iPort > 0 Then
        'Anschluß bestimmen
        PrinterPort = Mid(Buffer, iDriver + 1, _
        iPort - iDriver - 1)
    End If
End If

End Sub

Private Sub DefPrint_DblClick(Cancel As Integer)

            Dim xxnam As String
            Dim PD As PRINTER_DEFAULTS
            Dim RetVal As Long, hPrinter As Long
            
            PD.pDatatype = 0
            PD.DesiredAccess = PRINTER_ALL_ACCESS
            PD.pDevMode = 0
            xxnam = Trim(Me!DefPrint.Value)
            
            RetVal = OpenPrinter(xxnam, hPrinter, PD)
            If RetVal = 0 Then
                MsgBox "Otvori pisa?: Neuspješno!"
            Else
                RetVal = PrinterProperties(hWndAccessApp, hPrinter)
                RetVal = ClosePrinter(hPrinter)
            End If
            
End Sub

And that's about it.

 

[markphsd]

Alfalf,

One day to make a day less rough is to make someone happy. Thanks, this made me happy,



Mark P.

http://www.cafecartel.com

Providing Low Cost Powerful Point of Sale Solutions.

 

[alfalf]

In Last procedure (second part of code) where there's premissions check, put instead of MsgBox code line existing this one:

MsgBox "Open Printer: Unsuccesfully!" & vbCrLf & vbCrLf & "You seem to have no premission on this Mashine to do this job.", vbCritical + vbOKOnly, "PRINTERS"

I use it in several lang. apps, and missed to translate to english thise one.

 

[Clifford1]

Hi,
I am new to this so please be patient.....
would it be possible to get an english translation of the comments.....My linguistic skill are somewhat low( actually the just plain suck...)....

and by trhe way have you tried this yet and how does it work?
Clifford1

 

[PHV]

With a recent version of access, why not simply play with the Application.Printers collection and the Application.Printer property ?

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ222-2244

 

[markphsd]

PHV,

This was an excersise in changing the default printer of Windows, not the printer that access will print the report to. From what I understand, Application.printers collection does not allow you to change the default printer of windows.





Mark P.

http://www.cafecartel.com

Providing Low Cost Powerful Point of Sale Solutions.

 

[Jduenyas]

The following works for me. Much simpler. No API.
Must have a reference to MS WORD object

Dim objWord As Word.Application
Dim strOriginalPrinter As String

On Error Resume Next
Set objWord = GetObject(, "word.application")
If Err.Number = 429 Then
Debug.Print Err.Number
Set m_objWord = CreateObject("Word.application")
Err.Clear
End If

' save original printer name
strOriginalPrinter = objWord.ActivePrinter

' The following changes the 'default' printer to the printer of your choise

' Printer name is a string so close it with quotation marks
objWord.ActivePrinter = "\\YourDIR\YourPrinterName"

'Do your stuff here
'...
'...
'...

' restore original printer

objWord.ActivePrinter = strOriginalPrinter

objWord.Quit


Good luck

Josh

 

[Golom]

Here's another take on it.

Public Function Set_Printer_As_Default(ByVal NewDefault As String) As String

    Dim nC                  As Integer
    Dim String_Len          As Long
    Dim strWinPath          As String
    Dim strSysFileName      As String
    Dim strRet              As String
    Dim Current_Default     As String
    Dim New_Printer         As String
    Dim Pr                  As Printer
    [COLOR=green]
    ' Windows wants "Device Name,Driver Name,Port" in the string to set
    ' a new default printer.[/color]
    New_Printer = ""
    For Each Pr In Printers
        If Pr.DeviceName = NewDefault Then
            New_Printer = Pr.DeviceName & "," & Pr.DriverName & "," & Pr.Port
            Exit For
        End If
    Next
[COLOR=green]
    ' Get the path of the Windows\System directory.[/color]
    strWinPath = Space$(MAX_FILENAME_LEN)
    String_Len = GetWindowsDirectory(strWinPath, MAX_FILENAME_LEN)
    strWinPath = Left$(strWinPath, String_Len)
    strSysFileName = strWinPath & "\win.ini"

    ' Get the current default printer
    ' This will be of the form 'DeviceName,DriverName,Port'
    ' For example "iDP3210 Full Cut,iDP3210,LPT1:"
    strRet = Space$(MAX_FILENAME_LEN)
    String_Len = GetPrivateProfileString("windows", "device", "", strRet, MAX_FILENAME_LEN, strSysFileName)
    Current_Default = Left$(strRet, String_Len)
    [COLOR=green]
    ' If he didn't provide a new printer name then just return the current default.[/color]
    If Len(New_Printer) = 0 Then
        nC = InStr(1, Current_Default, ",")
        If nC = 0 Then nC = Len(Current_Default) + 1
        Set_Printer_As_Default = Left$(Current_Default, nC - 1)
        Exit Function
    End If
    [COLOR=green]
    ' Don't bother to set it if the new default is already the default.[/color]
    If Current_Default <> New_Printer Then
        ' Set the selected printer as the default.
        String_Len = WritePrivateProfileString("windows", "device", New_Printer, strSysFileName)
        SendMessage HWND_BROADCAST, WM_WININICHANGE, 32767&, ByVal "windows"
    End If
    [COLOR=green]
    ' Return the name of the previous default printer as the function value.[/color]
    nC = InStr(1, Current_Default, ",")
    If nC = 0 Then nC = Len(Current_Default) + 1
    Set_Printer_As_Default = Left$(Current_Default, nC - 1)
    
End Function

This just sets the printer to whatever printer name you supply and returns the name of the printer that was the default before the change so that you can change it beck later if necessary.

 

[markphsd]

Golom,

I like your take. You have a couple of functions in here that i don't have. Getwindowsdirectory, GetPrivateProfileString..

i can't use this this function becuase i don't have some of the called functions.

If you could provide them i'd appreciate it.

Mark P.

http://www.cafecartel.com

Providing Low Cost Powerful Point of Sale Solutions.

 

[Golom]

Sure

Public Declare Function GetWindowsDirectory Lib "kernel32" _
        Alias "GetWindowsDirectoryA" _
        (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Public Declare Function GetPrivateProfileString _
        Lib "kernel32" Alias "GetPrivateProfileStringA" _
        (ByVal lpSectionName As String, _
        ByVal lpKeyName As Any, _
        ByVal lpDefault As String, _
        ByVal lpReturnedString As String, _
        ByVal nSize As Long, _
        ByVal lpFileName As String) As Long

I've also found since I posted that code that it needs a DoEvents at the end on Windows XP systems to allow the OS to actually process the changes.