Hallo,
versuche es mal hiermit,
ich kann aber Dir nicht sagen was passiert,
wenn der neue Drucker irgendwelche Optionen nicht unterstützt.
Musst Du mal testen.
Option Explicit
Private Declare Function lstrcpy Lib "kernel32.dll" Alias _
"lstrcpyA" (ByVal lpString1 As String, _
ByVal lpString2 As Long) As Long
Private Declare Function lstrlen Lib "kernel32.dll" Alias _
"lstrlenA" (ByVal lpString As Long) As Long
Private Declare Function EnumPrinters Lib "winspool.drv" _
Alias "EnumPrintersA" (ByVal flags As Long, _
ByVal name As String, ByVal Level As Long, _
pPrinterEnum As Long, ByVal cdBuf As Long, _
pcbNeeded As Long, pcReturned As Long) As Long
Private Const PRINTER_ENUM_LOCAL = &H2
Private Const PRINTER_ENUM_NETWORK = &H40
Private Const PRINTER_ENUM_CONNECTIONS = &H4
Private Const PRINTER_ENUM_DEFAULT = &H1
Private Const PRINTER_ENUM_REMOTE = &H10
Private Const PRINTER_ENUM_SHARED = &H20
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias _
"RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, _
ByVal lpValueName As String, lpcbValueName As Long, ByVal _
lpReserved As Long, lpType As Long, lpData As Byte, _
lpcbData As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal _
lpValueName As String, ByVal lpReserved As Long, _
lpType As Long, lpData As Any, lpcbData As Long) As Long
Private 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
Private Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32" _
Alias "GetVersionExA" (lpVersionInformation As _
OSVERSIONINFO) As Integer
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_QUERY_VALUE = &H1
Private Const READ_CONTROL = &H20000
Private Const KEY_READ = (READ_CONTROL Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY)
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_CURRENT_CONFIG = &H80000005
Private Const HKEY_USERS = &H80000003
Private Const HKEY_PERFORMANCE_DATA = &H80000004
Private Const HKEY_DYN_DATA = &H80000006
Private Const Schlüsselname = "Software\Microsoft\Windows NT\CurrentVersion\Devices\"
Private Function FindDrucker(ByVal sDruckerName$) As String
Dim dummy, hwndSchlüssel&
Dim Länge&, lngIndex&
Dim strFeld As String, lngLänge As Long
Dim arrPuffer() As Byte, strPuffer As String
Dim lngArrLänge As Long, lngPortlänge As Long
Dim Drucker As String
dummy = RegOpenKeyEx(HKEY_CURRENT_USER, _
Schlüsselname, 0&, KEY_READ, hwndSchlüssel)
If dummy <> 0 Then MsgBox "Falscher Schlüssel": Exit Function
strFeld = String(1024, 0)
lngLänge = 1023
Redim arrPuffer(0 To 1000)
Do While RegEnumValue(hwndSchlüssel, lngIndex, _
strFeld, lngLänge, 0&, ByVal 0&, ByVal 0&, ByVal 0&) = 0
Drucker = Left$(strFeld, lngLänge) & " auf "
lngArrLänge = 1024
RegEnumValue hwndSchlüssel, lngIndex, strFeld, _
lngLänge, 0&, 0&, arrPuffer(0), lngArrLänge
strPuffer = (StrConv(arrPuffer, vbUnicode))
lngPortlänge = InStr(1, strPuffer, ":") - InStr(1, strPuffer, ",")
strPuffer = Mid$(strPuffer, InStr(1, strPuffer, ":") - 4, lngPortlänge)
Drucker = Drucker & strPuffer
If Drucker Like sDruckerName Then FindDrucker = Drucker: Exit Do
lngIndex = lngIndex + 1
strFeld = String(1024, 0)
lngLänge = 1023
Loop
dummy = RegCloseKey(hwndSchlüssel)
End Function
Sub TestDruckerUmstellen()
Dim sAktuellerDrucker As String
'aktuellen Drucker in einem String merken
sAktuellerDrucker = Application.ActivePrinter
'Drucker Suchen, Platzhalter verwenden
Application.ActivePrinter = FindDrucker("Microsoft XPS Document Writer*")
'hier Dein Code für die Kopfzeile
'...
'...
'Drucker wieder zurückstellen
Application.ActivePrinter = sAktuellerDrucker
End Sub
Gruß Tino