Netzwerkdrucker anspringen per VBA
18.07.2006 10:55:22
Martin
ich hoffe mir kann hier jemand helfen.
Euer Forum war bisher jedenfalls für mich immer hilfreich.
Folgendes ist der Fall:
Ich möchte per VBA einen Netzwerkdrucker anspringen, diese Excel muss aber auf verschiedenen Rechnern laufen. Ich habe hierzu schon den unten stehenden Code gefunden, der auch bis auf ein Problemchen funktioniert. Dieses krieg ich aber nicht gelöst...
Nachdem der Code den Drucker richtig ermittelt hat, gibt er diesen unter aPrinter als ",,domäne,drucker" aus, wo natürlich ein Feher entsteht, da ja "\\domäne\drucker" erwartet wird... Was ist das Problem ?
Ach so, OS ist Win 2000...
Der (hier) gefundene Code:
Option Explicit
'(C) by Ramses
'Liest alle installierten Netzwerk-
'und lokalen Drucker aus
'Das gehört in ein Modul
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Declare Function RegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" ( _
ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
phkResult As Long) As Long
Declare Function RegEnumKeyEx _
Lib "advapi32.dll" Alias "RegEnumKeyExA" ( _
ByVal hKey As Long, _
ByVal dwIndex As Long, _
ByVal lpName As String, _
lpcbName As Long, ByVal _
lpReserved As Long, _
ByVal lpClass As String, _
lpcbClass As Long, _
lpftLastWriteTime As FILETIME) As Long
Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Public Function fncEnumInstalledPrintersReg() As Collection
'Liest alle am lokalen Computer
'installierten Drucker aus
Dim tmpFunctionResult As Boolean
Dim aFileTimeStruc As FILETIME
Dim AddressofOpenKey As Long, aPrinterName As String
Dim aPrinterIndex As Integer, aPrinterNameLen As Long
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const HKEY_LOCAL_MACHINE = &H80000002
Set fncEnumInstalledPrintersReg = New Collection
aPrinterIndex = 0
tmpFunctionResult = Not CBool( _
RegOpenKeyEx( _
hKey:=HKEY_LOCAL_MACHINE, _
lpSubKey:="SYSTEM\CURRENTCONTROLSET\CONTROL\PRINT\PRINTERS", _
ulOptions:=0, _
samDesired:=KEY_ENUMERATE_SUB_KEYS, _
phkResult:=AddressofOpenKey))
If tmpFunctionResult = False Then GoTo ExitFunction
Do
aPrinterNameLen = 255
aPrinterName = String(aPrinterNameLen, CStr(0))
tmpFunctionResult = Not CBool _
(RegEnumKeyEx _
(hKey:=AddressofOpenKey, _
dwIndex:=aPrinterIndex, _
lpName:=aPrinterName, _
lpcbName:=aPrinterNameLen, _
lpReserved:=0, _
lpClass:=vbNullString, _
lpcbClass:=0, _
lpftLastWriteTime:=aFileTimeStruc))
aPrinterIndex = aPrinterIndex + 1
If tmpFunctionResult = False Then Exit Do
aPrinterName = Left(aPrinterName, aPrinterNameLen)
On Error Resume Next
fncEnumInstalledPrintersReg.Add aPrinterName
On Error GoTo 0
Loop
Call RegCloseKey(AddressofOpenKey)
Exit Function
ExitFunction:
If Not AddressofOpenKey = 0 Then _
Call RegCloseKey(AddressofOpenKey)
Set fncEnumInstalledPrintersReg = Nothing
End Function
Public Function fncEnumInstalledPrintersRegNetwork() As Collection
'Liest alle unter dem Benutzer
'installierten Netzwerkdrucker aus
Dim tmpFunctionResult As Boolean
Dim aFileTimeStruc As FILETIME
Dim AddressofOpenKey As Long, aPrinterName As String
Dim aPrinterIndex As Integer, aPrinterNameLen As Long
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const HKEY_Current_user = &H80000001
Set fncEnumInstalledPrintersRegNetwork = New Collection
aPrinterIndex = 0
tmpFunctionResult = Not CBool( _
RegOpenKeyEx( _
hKey:=HKEY_Current_user, _
lpSubKey:="Printers\Connections", _
ulOptions:=0, _
samDesired:=KEY_ENUMERATE_SUB_KEYS, _
phkResult:=AddressofOpenKey))
If tmpFunctionResult = False Then GoTo ExitFunction
Do
aPrinterNameLen = 255
aPrinterName = String(aPrinterNameLen, CStr(0))
tmpFunctionResult = Not CBool _
(RegEnumKeyEx _
(hKey:=AddressofOpenKey, _
dwIndex:=aPrinterIndex, _
lpName:=aPrinterName, _
lpcbName:=aPrinterNameLen, _
lpReserved:=0, _
lpClass:=vbNullString, _
lpcbClass:=0, _
lpftLastWriteTime:=aFileTimeStruc))
aPrinterIndex = aPrinterIndex + 1
If tmpFunctionResult = False Then Exit Do
aPrinterName = Left(aPrinterName, aPrinterNameLen)
On Error Resume Next
fncEnumInstalledPrintersRegNetwork.Add aPrinterName
On Error GoTo 0
Loop
Call RegCloseKey(AddressofOpenKey)
Exit Function
ExitFunction:
If Not AddressofOpenKey = 0 Then _
Call RegCloseKey(AddressofOpenKey)
Set fncEnumInstalledPrintersRegNetwork = Nothing
End Function
Private Sub CommandButton1_Click()
Dim aPrinter As Variant
Dim oldPrinter As Variant
Dim iRow As Integer
oldPrinter = Application.ActivePrinter
For Each aPrinter In fncEnumInstalledPrintersReg
Debug.Print "Lokale Drucker: " & aPrinter
If InStr(1, aPrinter, "Drucker2") > 0 Then
Application.ActivePrinter = aPrinter
'Befehl zum Ausdrucken
'Dein Code
'Drucker zurücksetzen
Application.ActivePrinter = oldPrinter
Exit Sub
End If
Next aPrinter
For Each aPrinter In fncEnumInstalledPrintersRegNetwork
Debug.Print "Netzwerkdrucker: " & aPrinter
If InStr(1, aPrinter, "Drucker2") > 0 Then
Application.ActivePrinter = aPrinter
'Befehl zum Ausdrucken
'Dein Code
'Drucker zurücksetzen
Application.ActivePrinter = oldPrinter
Exit Sub
End If
Next aPrinter
End Sub
________________________________
ThanX a Lot für jede Meinung...