Beispiel:

Option Explicit
 
Public Type VS_FIXEDFILEINFO
  dwSignature            As Long
  dwStrucVersion         As Long
  dwFileVersionMS        As Long
  dwFileVersionLS        As Long
  dwProductVersionMS     As Long
  dwProductVersionLS     As Long
  dwFileFlagsMask        As Long
  dwFileFlags            As Long
  dwFileOS               As Long
  dwFileType             As Long
  dwFileSubtype          As Long
  dwFileDateMS           As Long
  dwFileDateLS           As Long
End Type
 
Public Declare Function GetFileVersionInfoSize _
    Lib "Version.dll" Alias _
    "GetFileVersionInfoSizeA" _
    (ByVal lptstrFilename As String, _
    lpdwHandle As Long) As Long
Public Declare Function GetFileVersionInfo _
    Lib "Version.dll" Alias _
    "GetFileVersionInfoA" _
    (ByVal lptstrFilename As String, _
    ByVal dwHandle As Long, _
    ByVal dwLen As Long, _
    lpData As Any) As Long
Public Declare Function VerQueryValue _
    Lib "Version.dll" Alias _
    "VerQueryValueA" _
    (pBlock As Any, _
    ByVal lpSubBlock As String, _
    lplpBuffer As Any, _
    nVerSize As Long) As Long
Public Declare Function lstrlenA _
    Lib "kernel32" _
    (ByVal Ptr As Any) As Long
Public Declare Function lstrcpyA _
    Lib "kernel32" _
    (ByVal RetVal As String, _
    ByVal Ptr As Long) As Long
Public Declare Sub CopyMemory _
    Lib "kernel32" Alias _
    "RtlMoveMemory" _
    (Destination As Any, _
    Source As Any, _
    ByVal Length As Long)
 
Public Function GetFileDescription( _
                sSourceFile As String) _
                As String
  '// -----------------------------------------------------
  '// Methode:   | Ermittelt die Dateibeschreibung analog
  '//            | des Eigenschaftsfensters aus dem
  '//            | Explorer benötigt die Hilfsfunktionen
  '//            | GetStrFromPtrA und GetPointerToString
  '// -----------------------------------------------------
  '// Parameter: | sSourceFile = gültiger Dateipfad
  '// -----------------------------------------------------
  '// Rückgabe:  | Beschreibungstext der Datei
  '// -----------------------------------------------------
  '// Autor:     | Stefan Kulpa
  '//            | EDV Innovation & Consulting - Dormagen
  '// -----------------------------------------------------
  '// Beispiel:
  '// ?GetFileDescription("C:\WINNT\system32\notepad.exe")
  '// = "Editor"
  '// -----------------------------------------------------
 
  Dim uFixedFileInfo  As VS_FIXEDFILEINFO
  Dim abtBuffer()     As Byte
  Dim lBufferSize     As Long
  Dim lVerSize        As Long
  Dim lBuffer         As Long
  Dim lUnused         As Long
  Dim sTmpVer         As String
  Dim sBlock          As String
 
  If VBA.Len(sSourceFile) > 0 Then
    lBufferSize = GetFileVersionInfoSize(sSourceFile, _
        lUnused)
    ReDim abtBuffer(lBufferSize)
    If lBufferSize > 0 Then
      Call GetFileVersionInfo(sSourceFile, _
          0&, _
          lBufferSize, _
          abtBuffer(0))
      Call VerQueryValue(abtBuffer(0), "\", _
          lBuffer, lVerSize)
      Call CopyMemory(uFixedFileInfo, _
          ByVal lBuffer, _
          Len(uFixedFileInfo))
      If VerQueryValue(abtBuffer(0), _
          "VarFileInfoTranslation", _
          lBuffer, _
          lVerSize) Then
        If lVerSize Then
          sTmpVer = GetPointerToString(lBuffer, lVerSize)
          sTmpVer = Right("0" & _
                          Hex(Asc(Mid(sTmpVer, _
                          2, 1))), 2) & _
                          Right("0" & _
                          Hex(Asc(Mid(sTmpVer, _
                          1, 1))), 2) & _
                          Right("0" & _
                          Hex(Asc(Mid(sTmpVer, _
                          4, 1))), 2) & _
                          Right("0" & _
                          Hex(Asc(Mid(sTmpVer, _
                          3, 1))), 2)
          sBlock = "StringFileInfo" & sTmpVer _
                   & "FileDescription"
          If VerQueryValue(abtBuffer(0), sBlock, _
                           lBuffer, lVerSize) Then
            If lVerSize Then _
               GetFileDescription = GetStrFromPtrA(lBuffer)
          End If
        End If
      End If
    End If
  End If
 
End Function
 
Public Function GetPointerToString( _
                lpString As Long, _
                nBytes As Long) _
                As String
 
  Dim Buffer As String
  If nBytes Then
    Buffer = VBA.Space$(nBytes)
    CopyMemory ByVal Buffer, ByVal lpString, nBytes
    GetPointerToString = Buffer
  End If
 
End Function
 
Public Function GetStrFromPtrA( _
                ByVal lpszA As Long) _
                As String
 
  GetStrFromPtrA = VBA.String$(lstrlenA(ByVal lpszA), 0)
  Call lstrcpyA(ByVal GetStrFromPtrA, ByVal lpszA)
 
End Function