VBA Tipp: Das einem Dateityp zugeordnete Standardprogramm ermitteln

Aus DBWiki
Wechseln zu: Navigation, Suche

Anforderung

Ich möchte das einem Dateityp zugeordnete Standardprogramm (Pfad zur zugehörigen exe-Datei) in Windows ermitteln.

Lösung

Das geht mit der folgenden API-Funktion und VBA-Funktion, die in einem globalen Modul hinterlegt werden:

Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" ( _
                         ByVal lpFile As String, _
                         ByVal lpDirectory As String, _
                         ByVal lpResult As String _
                         ) As Long
 
Public Function StandardProgramm(Dateipfad As String) As String
 
 'Diese Funktion ermittelt das einem Dateityp (Parameter Dateipfad) zugeordnete Standardprogramm
 'und gibt den Pfad und Namen der exe-Datei des Standardprogramms zurück.
 'Wird kein Standardprogramm gefunden, so wird ein Leerstring zurückgegeben.
 'Quelle: www.dbwiki.net oder www.dbwiki.de
 
 Dim tmpDatei As String
 Dim d As Integer
 Dim strPfad As String
 
 strPfad = Space(260)
 
 'wenn die Datei nicht existiert, temporäre Datei erzeugen
 If CreateObject("Scripting.FileSystemObject").FileExists(Dateipfad) = False Then
   tmpDatei = CurrentProject.Path & "\" & Dateipfad
   d = FreeFile
   Close #d
   Open tmpDatei For Output As #d
   Close #d
   FindExecutable tmpDatei, vbNullString, strPfad
 Else
   FindExecutable Dateipfad, vbNullString, strPfad
 End If
 
 strPfad = Left(strPfad, InStr(strPfad, vbNullChar) - 1)
 
 'wenn der Dateipfad im gefundenen Pfad enthalten ist, ist das Ergebnis unbrauchbar (z.B. bei exe-Dateien)
 If InStr(strPfad, Dateipfad) > 0 Then
   strPfad = ""
 End If
 
 On Error Resume Next
 'temporäre Datei wieder löschen
 Kill tmpDatei
 On Error GoTo 0
 
 StandardProgramm = strPfad
 
End Function

Anwendungsbeispiele

Der Parameter "Dateipfad" muss

  • entweder den Namen einer fiktiven, nicht existierenden Datei (ohne Pfad) enthalten.
Entscheidend ist die Angabe der richtigen Dateierweiterung, z.B.
abc.htm,
test.doc,
  • oder den vollständigen Pfad zu einer existierenden Datei enthalten, z.B.
CurrentProject.Path & "\Meine.pdf",
 Dim strDateipfad As String
 Dim strProgrammpfad As String
 
 'Beispiel 1: Pfad zum Standardbrowser auslesen (fiktiver Dateiname)
 strDateipfad = "abc.htm"
 strProgrammpfad = StandardProgramm(strDateipfad)
 
 'Beispiel 2: Pfad zur WINWORD.EXE auslesen (fiktiver Dateiname)
 strDateipfad = "test.doc"
 strProgrammpfad = StandardProgramm(strDateipfad)
 
 'Beispiel 3: Pfad zum aktuellen PDF-Programm auslesen (existierender, kompletter Pfad zu einer Datei)
 strDateipfad = "D:\Eigene Dokumente\Meine.pdf"
 strProgrammpfad = StandardProgramm(strDateipfad)
 
 
 'Auswertung des Rückgabewertes
 If strProgrammpfad <> "" Then
   MsgBox strProgrammpfad
 Else
   MsgBox "Kein Standardprogramm gefunden"
 End If

Wiki-Links

Web-Links