COMO DEFINIR A IMPRESSORA PADRAO DO WIN VIA CODIGO

insira o código abaixo no módulo :

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

Public Function GetDefaultPrinter() As Printer
Dim strBuffer As String * 254
Dim iRetValue As Long
Dim strDefaultPrinterInfo As String
Dim tblDefaultPrinterInfo() As String
Dim objPrinter As Printer

' pega as informacoes da impressora padrao
  iRetValue = GetProfileString("windows", "device", ",,,", strBuffer, 254)
  strDefaultPrinterInfo = Left(strBuffer, InStr(strBuffer, Chr(0)) - 1)
  tblDefaultPrinterInfo = Split(strDefaultPrinterInfo, ",")
  For Each objPrinter In Printers
        If objPrinter.DeviceName = tblDefaultPrinterInfo(0) Then
          ' se achou a impressora padrao entao sai
          Exit For
        End If
   Next
   ' se nao achou retrona nothing
  If objPrinter.DeviceName  tblDefaultPrinterInfo(0) Then
      Set objPrinter = Nothing
  End If
  Set GetDefaultPrinter = objPrinter
End Function


No formulário padrão:
Private Sub Command1_Click()

Dim objPrinter As Printer
Set objPrinter = GetDefaultPrinter()

MsgBox "Impressora padrao = " + objPrinter.DeviceName & vbCrLf & _
"Driver da impressora = " + objPrinter.DriverName & vbCrLf & _
"A porta usada é a = " + objPrinter.Port

Set objPrinter = Nothing

End Sub 

'No módulo
Public Function SelectPrinter(byVal Nome as String) As Boolean
  Dim X as Printer
  For each X in Printers
    If Ucase(Mid(X.DeviceName,1,8))=UCase(Mid(Nome,1,8)) then
      Set Printer=X
      SelectPrinter = True
      Exit For
    End If
  Next
  SelectPrinter = False
End Function


'P/ chamar:
Dim RET As Boolean
RET = SelectPrinter("Epson LX-300")
If RET = True Then
  'A impressora foi encontrada e selecionada.
Else
  'A impressora NÃO foi encontrada.
End If
A função definirá esta impressora ("Epson LX-300", como no exemplo) como padrão para a impressão a ser realizada. 

ATENÇÃO!!!! Para que essa função funcione, você necessitará ter o Service Pack 3 do Visual Basic instalado em sua máquina para corrigir um bug do VB.

WEBMASTER do VBWEB.