PDF-Dateien öffnen - auch wenn in Unterordner...

Frage: In einem Tabellenblatt habe ich in einer Spalte Nummern stehen. Es befinden sich im gleichen Ordner wie die Exceldatei PDF-Dateien. PDF-Dateien können aber auch noch in einem Unterordner sein. Diese PDF-Dateien haben den gleichen Namen wie die Nummern in Excel. Wie kann ich die PDF-Dateien öffnen?

In a worksheet I have in a column numbers. There are in the same folder as the Excel file PDF files. But PDF files can also be in a subfolder. These PDF files have the same name as the numbers in Excel. How can I open the PDF files?

Hier noch eine Beispieldatei / Here's a sample file:
PDF-Dateien öffnen - auch wenn in Unterordner...[ZIP 800 KB]

Option Explicit
' Bedingte Kompilierung - wenn 64 Bit dann...
#If Win64 Then
    Private Declare PtrSafe Function SearchTreeForFile Lib "imagehlp.dll" _
        (ByVal RootPath As String, ByVal InputPathName As String, _
        ByVal OutputPathBuffer As String) As Long
' ... sonst...
#Else
    Private Declare Function SearchTreeForFile Lib "imagehlp.dll" _
        (ByVal RootPath As String, ByVal InputPathName As String, _
        ByVal OutputPathBuffer As String) As Long
#End If
' Bedingte Kompilierung - wenn 64 Bit dann...
#If Win64 Then
    Private Declare PtrSafe 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
#Else
    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
#End If
Private Const SW_MAXIMIZE = 3
' Dateierweiterung gegebenenfalls anpassen!!!
Const strEX As String = ".pdf"
'--------------------------------------------------------------------------
' Module    : Sheet1
' Procedure : BeforeDoubleClick
' Author    : Case (Ralf Stolzenburg)
' Date      : 22.11.2013
' Purpose   : Open PDF files - even if in subfolder...
'--------------------------------------------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ' Variablendeklaration
    ' Stringvariable mit Puffer
    Dim strPathName As String * 255
    Dim strName As String
    Dim lngTMP As Long
    On Error GoTo Fin
    ' Einschränkung auf Spalte 3 = C
    If Not Intersect(Target, Columns(3)) Is Nothing Then
        ' Nach Doppelklick auf Zelle NICHT in den Bearbeitungsmodus wechseln
        Cancel = True
        ' Datei suchen, wenn gefunden ist der Rückgabewert ein Long ungleich 0
        lngTMP = SearchTreeForFile(ThisWorkbook.Path & _
            Application.PathSeparator, Target.Text & _
            strEX, strPathName)
        If lngTMP = 0 Then
            ' Datei nicht vorhanden!
            MsgBox "File not found!"
        Else
            ' Puffer zurechtstutzen, überflüssige Leerzeichen weg
            strPathName = Left$(strPathName, InStr(1, strPathName, vbNullChar) - 1)
            strName = RTrim(strPathName)
            ' Datei öffnen
            ShellExecute 0, "Open", strName, "", "", SW_MAXIMIZE
        End If
    End If
Fin:
    ' Wenn ein Fehler auftritt gib ihn aus mit Fehlernummer und Beschreibung
    If Err.Number <> 0 Then MsgBox "Error: " & _
        Err.Number & " " & Err.Description
End Sub

Kommentare

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...