AW: Ich hab schon so was befürchtet...
05.01.2009 23:23:08
Roland
Hi Boris,
wenn es dir gelänge, deine Intranet-Hyperlinks auf Laufwerkpfade á la "F:\Intranet\test.pdf" umzustellen, hätte ich noch folgendes (den ganzen Ramsch in ein allgemeines Modul):
Option Explicit
Private Declare Function GetShortPathNameA Lib "kernel32.dll" (ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Private Declare Function ShellExecuteA Lib "shell32.dll" (ByVal hWnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) _
As Long
Private Declare Function GetActiveWindow Lib "user32.dll" () As Long
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private Const MAX_PATH = 260&
Private Const SW_HIDE = 0&
Public Sub Seriendruck()
Dim rngLinks As Range, rng As Range, strPfad As String
Dim strOldPrinter As String, strNewPrinter As String, strDefaultPrinter As String
Dim objWMI As Object, objItem As Object
Set rngLinks = Application.InputBox("Bitte nur Zellen mit den auszudruckenden PDF-Links _
markieren", Type:=8)
On Error Resume Next
For Each rng In rngLinks
If rng Is Nothing Or Right$(rng.Text, 4) ".pdf" Then
MsgBox "Bitte nur Zellen mit PDF-Links auswählen", vbOKOnly, "Abbruch des PDF-Druckes"
Exit Sub
End If
Next
On Error GoTo 0
Set objWMI = GetObject("winmgmts:\\.\root\cimv2"). _
ExecQuery("Select * from Win32_Printer where Default = 'true'")
For Each objItem In objWMI
strDefaultPrinter = objItem.properties_.Item("Name").Value
Next
strOldPrinter = Application.ActivePrinter
If Not Application.Dialogs(xlDialogPrinterSetup).Show Then Exit Sub
strNewPrinter = Application.ActivePrinter
If strNewPrinter strOldPrinter Then
Set objWMI = GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select * from Win32_Printer")
For Each objItem In objWMI
If CBool(InStr(strNewPrinter, objItem.Name)) Then
objItem.SetDefaultPrinter
Exit For
End If
Next
End If
For Each rng In rngLinks
strPfad = rng.Text
PDF_Druck (strPfad)
Next
Application.ActivePrinter = strOldPrinter
Set objWMI = GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select * from Win32_Printer")
For Each objItem In objWMI
If InStr(1, strDefaultPrinter, objItem.Name) 0 Then
objItem.SetDefaultPrinter
Exit For
End If
Next
End Sub
Private Sub PDF_Druck(Dateiname As String)
Dim strPath As String, strShortPath As String, strFile As String
strPath = Mid$(Dateiname, 1, InStrRev(strFile, "\"))
strShortPath = Space(MAX_PATH)
GetShortPathNameA Dateiname, strShortPath, MAX_PATH
strShortPath = Left$(strShortPath & vbNullChar, InStr(strShortPath, vbNullChar) - 1)
ShellExecuteA GetActiveWindow, "print", strShortPath, vbNullString, strPath, SW_HIDE
Sleep 2000
End Sub
Das läuft bei mir definitiv und stellt dir den Drucker nach erfolgten Druckjobs auch wieder auf den vorherigen Drucker zurück.
Guts Nächtle aus dem kalten und dunklen (und gruseligen) Berlin
Roland Hochhäuser