AW: mittels button eine pdf Datei suchen und drucken
31.10.2014 10:53:03
Tino
Hallo,
kannst mal so testen.
Evtl. in dieser Zeile die Pause für den Code anpassen, damit genügend Zeit bleibt für den Ausdruck.
Application.Wait Now + TimeSerial(0, 0, 5) 'Zeit für ausdruck
Option Explicit
Public Declare Function ShellExecute Lib "shell32.dll" Alias _
"ShellExecuteA" (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 FindWindow Lib "user32" _
Alias "FindWindowA" (ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function PostMessage Lib "user32" _
Alias "PostMessageA" (ByVal hwnd As Long, _
ByVal wMsg As Long, ByVal wParam As Long, _
ByVal lParam As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" _
(ByVal hwnd As Long, lpdwProcessId As Long) As Long
Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, _
ByVal wCmd As Long) As Long
Const SW_HIDE = 0 ' Versteckt öffnen
Const SW_MAXIMIZE = 3 ' Maximiert öffnen
Const SW_MINIMIZE = 6 ' Minimiert öffnen
Const SW_NORMAL = 1
Const WM_CLOSE = &H10
Const SYNCHRONIZE = &H100000
Sub Print_PDF()
Dim sDir$, sPath$, SuchNr$
Dim hWindow&
SuchNr = Tabelle1.Range("G1").Value
If Trim$(SuchNr) = "" Then
Exit Sub 'in G1 steht nix
End If
sPath = "G:\1 Forum\"
On Error GoTo ErrorHandler:
ChDrive sPath
ChDir sPath
sDir = Dir$(sPath & SuchNr & " *.pdf", vbNormal)
If sDir <> "" Then
hWindow = ShellExecute(0&, "print", sDir, "", "", SW_NORMAL)
Application.Wait Now + TimeSerial(0, 0, 5) 'Zeit für ausdruck
DoEvents
hWindow = SearchHndByWndName_Parent("Adobe Acrobat")
PostMessage hWindow, WM_CLOSE, 0&, 0&
Else
MsgBox "Datei nicht gefunden!", vbExclamation
End If
Exit Sub
ErrorHandler:
MsgBox Err.Description, _
vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
"Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End Sub
Private Function SearchHndByWndName_Parent(strSearch As String) As Long
Dim strTMP As String * 100
Dim nhWnd As Long
Const GW_HWNDNEXT = 2
nhWnd = FindWindow(vbNullString, vbNullString)
Do While Not nhWnd = 0
If GetParent(nhWnd) = 0 Then
GetWindowText nhWnd, strTMP, 100
If InStr(strTMP, strSearch) > 0 Then
SearchHndByWndName_Parent = nhWnd
Exit Do
End If
End If
nhWnd = GetWindow(nhWnd, GW_HWNDNEXT)
Loop
End Function
Gruß Tino