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: http://www.dbwiki.net/
 
   Dim tmpDatei As String
   Dim dNum     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
      dNum = FreeFile()
      Open tmpDatei For Output As dNum
      Close dNum
      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 = vbNullString
   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 & "\Eine.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

Wikilinks

Web-Links