Tipp 1.2 - Programm ermitteln

Wie kann ich ein ausführbares Programm für eine Datei ermitteln?

Mit dieser Funktion können Sie ein ausführbares Programm für eine Datei ermitteln. Kopieren Sie einfach nachfolgenden Quellcode in die Zwischenablage und fügen Sie anschließend den Inhalt der Zwischenablage in ein neues Modul ein. Die Aufrufparameter finden Sie im Quellcode beschrieben.

Api-AufrufeVerwendete Win32-Api-Aufrufe und Typen: FindFirstFile, FindNextFile, FindClose - FILETIME, WIN32_FIND_DATA

Beispiel:

Option Explicit
 
Public Declare Function GetShortPathName _
    Lib "kernel32" Alias _
    "GetShortPathNameA" _
    (ByVal lpszLongPath As String, _
    ByVal lpszShortPath As String, _
    ByVal cchBuffer As Long) As Long
 
Public Declare Function FindExecutable _
    Lib "shell32.dll" Alias _
    "FindExecutableA" _
    (ByVal lpFile As String, _
    ByVal lpDirectory As String, _
    ByVal lpResult As String) As Long
 
Public Function vbFindExecutable( _
                                ByVal sPath As String) _
                                As String
  '// -----------------------------------------------------
  '// Methode:   | Ausführbares Programm für eine Datei
  '//            | ermitteln
  '// -----------------------------------------------------
  '// Parameter: | sPath - gültiger Dateipfad
  '// -----------------------------------------------------
  '// Rückgabe:  | Pfad zum "zuständigen" Programm
  '// -----------------------------------------------------
  '// Beispiel:  | ?vbFindExecutable("C:\WINNT\SYSTEM.INI")
  '// -----------------------------------------------------
  '// Autor:     | Stefan Kulpa
  '//            | EDV Innovation & Consulting - Dormagen
  '// -----------------------------------------------------
 
  Dim sFile           As String
  Dim sChar           As String
  Dim sBuffer         As String
  Dim sShortPath      As String
  Dim sDirectory      As String
  Dim sBugfixedPath   As String
  Dim lResult         As Long
  Dim lOffset         As Long
 
  '// -----------------------------------------------------
  '// DOS-Pfad ermitteln
  '// -----------------------------------------------------
  sShortPath = VBA.String(260, 0)
  If GetShortPathName(sPath, sShortPath, Len(sShortPath)) _
      Then
    sPath = VBA.Left(sShortPath, _
        VBA.InStr(sShortPath, vbNullChar) - 1)
  End If
 
  '// -----------------------------------------------------
  '// Datei- und Ordner aus dem Gesamtpfad ermitteln
  '// (rudimentäre Methoden)
  '// -----------------------------------------------------
  sFile = VBA.Mid$(sPath, VBA.InStrRev(sPath, "\") + 1)
  sDirectory = VBA.Left$(sPath, Len(sPath) - Len(sFile))
 
  '// -----------------------------------------------------
  '// Zuständige Applikation ermitteln
  '// -----------------------------------------------------
  sBuffer = Space(260)
  FindExecutable sFile, sDirectory, sBuffer
 
  '// -----------------------------------------------------
  '// Bugfixing durchführen, da es u.U. fehlerhafte
  '// Registry-Einträge gibt
  '// -----------------------------------------------------
  sBuffer = Trim$(sBuffer)
  If Len(sBuffer) > 0 Then
    If InStr(sBuffer, vbNullChar) > 0 Then
      For lOffset = 1 To Len(sBuffer)
        sChar = Mid(sBuffer, lOffset, 1)
        If sChar <> vbNullChar Then
          sBugfixedPath = sBugfixedPath + sChar
        Else
          sBugfixedPath = sBugfixedPath + " "
        End If
      Next lOffset
    Else
      sBugfixedPath = sBuffer
    End If
  End If
  If Len(sBugfixedPath) > 0 Then
    lOffset = InStr(UCase(sBugfixedPath), UCase(sPath))
    If lOffset > 1 Then
      sBugfixedPath = Left(sBugfixedPath, lOffset - 1)
    End If
    '// Anführungszeichen
    If Asc(Right(sBugfixedPath, 1)) = 34 Then
      sBugfixedPath = Left(sBugfixedPath, _
          Len(sBugfixedPath) - 1)
    End If
  End If
  vbFindExecutable = Trim$(sBugfixedPath)
 
End Function


Zurück Tipp 1.1 - Anzahl Dateien | Inhalt | Tipp 1.3 - Ordnerpfad erstellen Weiter