PDF-File von Excel aus starten und ...

Sub test() With ActiveSheet.Columns(20) Set splitt = .Find("SplittFehler", LookIn:=xlValues, LookAt:=xlWhole) If Not splitt Is Nothing Then firstAddress = splitt.Address Do With splitt.Interior .ColorIndex = 40 .Pattern = xlSolid End With With splitt.Offset(0, -10).Interior .ColorIndex = 40 .Pattern = xlSolid ' Suche und öffne Datei Set fs = Application.FileSearch path = "D:\test\" With fs .LookIn = path .SearchSubFolders = True .Filename = splitt.Offset(0, -10).Value If .Execute() > 0 Then For i = 1 To .FoundFiles.Count File = .FoundFiles(i) Shell Chr(34) & "C:\Program Files\Adobe\Acrobat 6.0\Acrobat\Acrobat.exe" & Chr(34) & _ Chr (34) & File & Chr(34), vbMaximizedFocus Next i Else MsgBox "There were no files found." End If End With End With Set splitt = .FindNext(splitt) Loop While Not splitt Is Nothing And splitt.Address <> firstAddress End If End With End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo nochmal!
Hab jetzt deinen Code abgeändert, so dass es für mich passt. Aber leider erhält das Excel-Fenster danach immer noch nicht den Fokus! Am Ende seh ich wieder nur Arcobat im Vordergrund ...
Schau doch bitte mal drüber, weiß nich worans liegt. :-(
Private Declare


Function GetShortPathName Lib "kernel32.dll" Alias "GetShortPathNameA" ( _
ByVal lpszLongPath As String, _
ByVal lpszShortPath As String, _
ByVal cchBuffer As Long) As Long
Private 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 SetWindowPos Lib "user32.dll" ( _
ByVal hWnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long
Private Declare 

Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare 

Sub Sleep Lib "kernel32.dll" ( _
ByVal dwMilliseconds As Long)
Private Declare 

Function GetWindowPlacement Lib "user32" ( _
ByVal hWnd As Long, _
ByRef lpwndpl As WINDOWPLACEMENT) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type WINDOWPLACEMENT
Length As Long
flags As Long
showCmd As Long
ptMinPosition As POINTAPI
ptMaxPosition As POINTAPI
rcNormalPosition As RECT
End Type
Private Const MAX_PATH = 260&
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Private Const SW_MAX = 10&

Sub test()
Dim path As String
Dim leer As String
Dim myShell As Object
Dim strPath As String, strShortPath As String, strFile As String
Dim hWnd As Long, WinEst As WINDOWPLACEMENT
Dim lngrow
With ActiveSheet.Columns(20)
Set splitt = .Find("SplittFehler", LookIn:=xlValues, LookAt:=xlWhole)
n = 5
If Not splitt Is Nothing Then
firstAddress = splitt.Address
Do
With splitt.Interior
.ColorIndex = 40
.Pattern = xlSolid
End With
With splitt.Offset(0, -10).Interior
.ColorIndex = 40
.Pattern = xlSolid
' Suche und öffne Datei
Set fs = Application.FileSearch
path = "\\w71c-122623\Lw_d\Elast_Ordner\E090421_Bearbeitung\"
With fs
.LookIn = path
.SearchSubFolders = True
.Filename = splitt.Offset(0, -10).Value
If .Execute() > 0 Then
lngrow = ""
If lngrow < Cells(Range("J65536").End(xlUp).Row, 10) Then
Cells(Range("J65536").End(xlUp).Row + n, 10) = "Splitt-Fehler in Datei " & "'" & fs.Filename & "'" & " :"
Cells(Range("J65536").End(xlUp).Row + 1, 10) = "'" & " --> Fehlende Seiten: "
n = 2
End If
For i = 1 To .FoundFiles.Count
File = Chr(34) & .FoundFiles(i) & Chr(34)
ShellExecute FindWindow("XLMAIN", vbNullString), "open", File, "", "", SW_MAX
Do
Sleep 100
hWnd = FindWindow("AdobeAcrobat", vbNullString)
If hWnd <> 0 Then GetWindowPlacement hWnd, WinEst
Debug.Print WinEst.showCmd
If WinEst.showCmd = 3 Then Exit Do
Loop
SetWindowPos FindWindow("XLMAIN", vbNullString), HWND_TOPMOST, _
0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW
SetWindowPos FindWindow("XLMAIN", vbNullString), HWND_NOTOPMOST, _
0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW
Next i
Else
MsgBox "There were no files found."
End If
End With
End With
Set splitt = .FindNext(splitt)
Loop While Not splitt Is Nothing And splitt.Address <> firstAddress
End If
End With
End Sub

Servus,
ich habs mal getestet. Das funktioniert bei mir einwandfrei. Das einzige was ich von Reader sehe, ist das Startfenster. Ich musste den Code ein bisschen eindampfen, da ich die Tabelle nicht nachbauen will. Teste es mal mit der Version. Leg dazu eine Ornder mit zwei oder drei PDF's an und pass den Pfad im Filesearch an.
Option Explicit

Private Declare Function GetShortPathName Lib "kernel32.dll" Alias "GetShortPathNameA" ( _
    ByVal lpszLongPath As String, _
    ByVal lpszShortPath As String, _
    ByVal cchBuffer As Long) As Long

Private 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 SetWindowPos Lib "user32.dll" ( _
    ByVal hWnd As Long, _
    ByVal hWndInsertAfter As Long, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal cx As Long, _
    ByVal cy As Long, _
    ByVal wFlags As Long) As Long

Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" ( _
    ByVal lpClassName As String, _
    ByVal lpWindowName As String) As Long

Private Declare Sub Sleep Lib "kernel32.dll" ( _
    ByVal dwMilliseconds As Long)

Private Declare Function GetWindowPlacement Lib "user32" ( _
    ByVal hWnd As Long, _
    ByRef lpwndpl As WINDOWPLACEMENT) As Long

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type WINDOWPLACEMENT
    Length As Long
    flags As Long
    showCmd As Long
    ptMinPosition As POINTAPI
    ptMaxPosition As POINTAPI
    rcNormalPosition As RECT
End Type

Private Const MAX_PATH = 260&

Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2

Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40

Private Const SW_MAX = 10&

Sub test()
    Dim path As String, i As Integer
    Dim leer As String, fs As FileSearch
    Dim myShell As Object, sFile As String
    Dim strPath As String, strShortPath As String, strFile As String
    Dim hWnd As Long, WinEst As WINDOWPLACEMENT
    Dim lngrow
    Set fs = Application.FileSearch
    With fs
        .LookIn = "D:\Eigene Dateien\test\" 'ANPASSEN !!!!!!!!!!!!!!!!!!!!!!!!
        .SearchSubFolders = True
        .Filename = "*.pdf"
        If .Execute > 0 Then
            For i = 1 To .FoundFiles.Count
                ShellExecute FindWindow("XLMAIN", vbNullString), "open", .FoundFiles(i), "", "", SW_MAX
            Next i
        Else
            MsgBox "There were no files found."
        End If
    End With
    Do
        Sleep 100
        hWnd = FindWindow("AdobeAcrobat", vbNullString)
        If hWnd <> 0 Then GetWindowPlacement hWnd, WinEst
        If WinEst.showCmd = 3 Then Exit Do
    Loop
    SetWindowPos FindWindow("XLMAIN", vbNullString), HWND_TOPMOST, _
        0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW
    SetWindowPos FindWindow("XLMAIN", vbNullString), HWND_NOTOPMOST, _
        0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE Or SWP_SHOWWINDOW
End Sub

Gruß
Nepumuk
Excel & VBA Beispiele

Beliebteste Forumthreads (12 Monate)

PDF-File von Excel aus starten und ...

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread