• Home
 · 
• Windows System Services
 · 
• This code allow print into combo box selected printer, Also allow set windows default printer Not u

This code allow print into combo box selected printer, Also allow set windows default printer Not u

This code allow print into combo box selected printer, Also allow set windows default printer Not use commondialog control.

Rate This code allow print into combo box selected printer, Also allow set windows default printer Not u

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'************************ 
' Printer setup module 
' Set/retrieves the default printer - originaly for VB6 
' Works for A97/a2000 
' This is minimal code. 
' How to use 
' To get the default printer 
' debug.print GetDefaultPrinter 
' To set the default printer 
' debug.print SetDefaultPrinter("HP Laser JET") 
' above returns true if success. 
' To get a list of printers suitable for a listbox, or combo 
' debug.print GetPrinters (in forms on-load event you 
' would use: 
' Me.Combo0.RowSource = GetPrinters 
' Me.Combo0 = GetDefaultPrinter 
' the first line loads up the combo box, the 2nd sets 
' the combo to the default. 
' 
' that is all there folks! 
' 
' Thus, when printing a report, you can: 
' 
' 1) save the default printer into a string 
' strCurrentPtr = GetDefaultPrinter 
' 2) switch to your report printer 
' SetDefaultPrinter strReportsPtr 
' 3) print report 
' 4) switch back to the default printer 
' SetDefaultPrinter strCurrentPtr 
' 
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) 
Private Const HWND_BROADCAST As Long = &HFFFF& 
Private Const WM_WININICHANGE As Long = &H1A 

' The following code allows one to read, and write to the WIN.INI files 
' In win 2000 the printer settings are actually in the registry. However, 
windows 
' handles this correctly 
' 
Private 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 

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

Private Declare Function SendMessage Lib "user32" _ 
Alias "SendMessageA" _ 
(ByVal hwnd As Long, _ 
ByVal wMsg As Long, _ 
ByVal wParam As Long, _ 
lparam As Any) As Long 
'API to Print Document 


Public Const SWP_NOACTIVATE = &H10 
Public Const SWP_HIDEWINDOW = &H80 

Public Declare Function ShellExecute 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 

'Private Sub Command1_Click() 
' ShellExecute Me.hwnd, "print", "TEXTRON_INVOICE.doc", _ 
' vbNullString, "C:\temp", SWP_NOACTIVATE Or SWP_HIDEWINDOW 
'End Sub 





Private Function fstrDField(mytext As String, delim As String, groupnum As 
Integer) As String 

' this is a standard delimiter routine that every developer I know has. 
' This routine has a million uses. This routine is great for splitting up 
' data fields, or sending multiple parms to a openargs of a form 
' 
' Parms are 
' mytext - a delimited string 
' delim - our delimiter (usually a , or / or a space) 
' groupnum - which of the delimited values to return 
' 

Dim startpos As Integer, endpos As Integer 
Dim groupptr As Integer, chptr As Integer 

chptr = 1 
startpos = 0 
For groupptr = 1 To groupnum - 1 
chptr = InStr(chptr, mytext, delim) 
If chptr = 0 Then 
fstrDField = "" 
Exit Function 
Else 
chptr = chptr + 1 
End If 
Next groupptr 
startpos = chptr 
endpos = InStr(startpos + 1, mytext, delim) 
If endpos = 0 Then 
endpos = Len(mytext) + 1 
End If 

fstrDField = Mid$(mytext, startpos, endpos - startpos) 

End Function 

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 

Function GetDefaultPrinter() As String 

Dim strDefault As String 
Dim lngbuf As Long 

strDefault = String(255, Chr(0)) 
lngbuf = GetProfileString("Windows", "Device", "", strDefault, 
Len(strDefault)) 
If lngbuf > 0 Then 
GetDefaultPrinter = fstrDField(strDefault, ",", 1) 
Else 
GetDefaultPrinter = "" 
End If 

End Function 


Function GetPrinters() As String 

' this routine returns a list of printers, separated by 
' a ";", and thus the results are suitable for stuffing into a combo box 

Dim strBuffer As String 
Dim strOnePtr As String 
Dim intPos As Integer 
Dim lngChars As Long 

strBuffer = Space(2048) 
lngChars = GetProfileString("PrinterPorts", vbNullString, "", strBuffer, 
Len(strBuffer)) 

If lngChars > 0 Then 
intPos = InStr(strBuffer, Chr(0)) 
Do While intPos > 1 
strOnePtr = Left(strBuffer, intPos - 1) 
strBuffer = Mid(strBuffer, intPos + 1) 
If GetPrinters <> "" Then GetPrinters = GetPrinters & ";" 
GetPrinters = GetPrinters & strOnePtr 
intPos = InStr(strBuffer, Chr(0)) 
Loop 
Else 
GetPrinters = "" 
End If 

End Function 

Public Function testPrintersGet() 
Debug.Print GetDefaultPrinter 
Debug.Print GetPrinters 
End Function