Standartdrucker automatisch umschalten lassen

Guten Morgen liebes ExcelForum,
ich habe da wieder ein kleine Problem, aber weiss überhaupt nicht wie ich das umsetzten könnte, habe auch versucht mit Schlagwörter etwas in Google zu finden, aber irgendwie ist es nicht wo nach ich suche. Vielleicht ist es auch nicht möglich, aus dem Grund suche ich bei euch Profis um Rat.
Ich möchte in mein Excel Programm folgendes haben:
1. Beim starten des Programms soll abgefragt werden ob ich über LAN (in der Firma) o. über WLAN VPN (Mobiler Router) verbunden bin und ggf. den Drucker in der Firma als Standartdrucker setzten o. den Mobilen Drucker extern als Standart definieren.
Ist sowas möglich und wenn ja wie?
Es gibt ja eine Möglichkeit unter Windows 7/10 selbst, das man bei den Druckereinstellungen, es definiert, was ich auch versucht habe, aber leider nicht klappen möchte.
Ich bedanke mich im Voraus für eure Unterstützung.
MfG
Anton

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Faxen() Dim savPrinter As String savPrinter = ActivePrinter ' aktuellen Drucker auslesen ActivePrinter = "WinFax Pro 9.0" ' anderen Drucker einstellen ActiveSheet.PrintOut ActivePrinter = savPrinter ' Drucker wieder zurückstellen End Sub

Private Declare Function CreateIC Lib "gdi32" Alias "CreateICA" (ByVal lpDriverName As String, _ ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As Long) As Long Public Function GetPDC(ByVal strPrinter As String) As Long GetPDC = CreateIC("WINSPOOL", strPrinter, vbNullString, 0&) End Function Sub Look_For_Printer() printer_name = "Name found in the print setup drop down" If GetPDC( printer_name ) = 0 Then msgbox("This printer is not on this computer") end if End Sub

dim myprinter as string dim printer_name as sttring printer_name ="name goes here" myprinter = Application.ActivePrinter Change_Form.PrintOut Preview:=False, ActivePrinter:=printer_name, PrintToFile:=True, _ PrToFileName:=PSFileName Application.ActivePrinter = myprinter

Private Declare Function CreateIC Lib "gdi32" Alias "CreateICA" (ByVal lpDriverName As String, _ _ ByVal lpDeviceName As String, ByVal lpOutput As String, ByVal lpInitData As Long) As Long Public Function GetPDC(ByVal strPrinter As String) As Long GetPDC = CreateIC("WINSPOOL", strPrinter, vbNullString, 0&) End Function Sub Drucker() 'Zeige Druckerauswahl 'Application.Dialogs(xlDialogPrinterSetup).Show Dim myprinter As String Dim printer1 As String Dim printer2 As String printer1 = "Drucker_1_LAN" printer2 = "Drucker_1_mobil" myprinter = Application.ActivePrinter If GetPDC(printer1) = 0 Then MsgBox (printer1 & " nicht verfügbar!") ActiveSheet.PrintOut Preview:=False, _ ActivePrinter:=printer2, _ PrintToFile:=True, _ PrToFileName:=PSFileName Else MsgBox (printer1 & " gefunden!") ActiveSheet.PrintOut Preview:=False, _ ActivePrinter:=printer1, _ PrintToFile:=True, _ PrToFileName:=PSFileName End If Application.ActivePrinter = myprinter End Sub

Private Sub CommandButton7_Click() 'Damit kann man Arbeiten MsgBox Application.ActivePrinter Dim objWMI As Object, objItem As Object, i, c Set objWMI = GetObject("winmgmts:\\.\root\cimv2"). _ ExecQuery("Select * from Win32_Printer where Name='Brother MFC-J4410DW Printer'") On Error Resume Next For Each objItem In objWMI For Each i In objItem.properties_ c = c + 1 Cells(c, 1) = i.name Cells(c, 2) = i.Value If i.name = "Status" And i.Value = "Degraded" Then Application.ActivePrinter = "Brother MFC-J4410DW Printer (Kopie 1)" MsgBox c & " - " & i.name & " - " & i.Value & vbLf & Application.ActivePrinter End If Next Next Set objWMI = Nothing End Sub

Hallo Anton,
habe jetzt noch ein wenig probiert. Bezüglich des Druckerstatus ist entweder mein Samsung Drucker ein mieses Drecksstück oder es ist eben hoffnungslos, diesen Status abzufragen. Er ist ebenfalls immer da, auch ohne Stromkabel...
Aber eine Variante hatte Erfolg, man kann es (bei Netzwerkdruckern) mit einem Ping versuchen:

Function IsConnectible(sHost, iPings, iTO)
' Returns True or False based on the output from ping.exe
' Works an "all" WSH versions
' sHost is a hostname or IP
' iPings is number of ping attempts
' iTO is timeout in milliseconds
' if values are set to "", then defaults below used
Dim nRes
If iPings = "" Then iPings = 1 ' default number of pings
If iTO = "" Then iTO = 550     ' default timeout per ping
With CreateObject("WScript.Shell")
nRes = .Run("%comspec% /c ping.exe -n " & iPings & " -w " & iTO _
& " " & sHost & " | find ""TTL="" > nul 2>&1", 0, True)
End With
IsConnectible = (nRes = 0)
End Function
Sub Drucker()
'Zeige Druckerauswahl
'Application.Dialogs(xlDialogPrinterSetup).Show
Dim myprinter As String
Dim printer1 As String
Dim printer2 As String
printer1 = "Drucker_1_LAN"
printerIP = "192.168.111.111"
printer2 = "Drucker_1_mobil"
myprinter = Application.ActivePrinter
If IsConnectible(printerIP, 2, 100) = False Then
MsgBox (printer1 & " nicht verfügbar!")
ActiveSheet.PrintOut Preview:=False, _
ActivePrinter:=printer2, _
PrintToFile:=True, _
PrToFileName:=PSFileName
Else
MsgBox (printer1 & " gefunden!")
ActiveSheet.PrintOut Preview:=False, _
ActivePrinter:=printer1, _
PrintToFile:=True, _
PrToFileName:=PSFileName
End If
Application.ActivePrinter = myprinter
End Sub

Beliebteste Forumthreads (12 Monate)

Standartdrucker automatisch umschalten lassen

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Standartdrucker automatisch umschalten lassen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread