Public Function Drucker_Wechseln(PrName As String)
' Parameter: Druckername
' Rückgabewert: Erfolg der Aktion
 
  Dim Buffer As String, RW, Tmp As String
 
  On Error GoTo Er
  Buffer = String(255, 0)
  RW = GetProfileString(ByVal "devices", ByVal PrName, ByVal "", Buffer, Len( _
    Buffer))
 
  If RW <= 0 Then
    Drucker_Wechseln = False
    Exit Function
  Else
    Tmp = PrName & "," & Mid(Buffer, 1, RW)
  End If
 
' Standarddrucker setzen
  RW = WriteProfileString(ByVal "Windows", ByVal "Device", ByVal Tmp)
  If RW <> 1 Then
    Drucker_Wechseln = False
    Exit Function
  End If
 
' und mitteilen, daß sich die WIN.INI geändert hat
  RW = SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0&, 0&)
  Drucker_Wechseln = True
 
Ex:
  Exit Function
 
Er:
  MsgBox "Drucker wechseln: " & Err.Description
  Drucker_Wechseln = False
  Resume Ex
 
End Function

Meine Homepage: www.dartrax.de