'クラスモジュール CFileVersionInfo///////////
Option Explicit

Private Declare Function GetFileVersionInfoSize Lib _
    "version.dll" Alias "GetFileVersionInfoSizeA" _
         (ByVal lptstrFilename As String, _
          lpdwHandle As Long) As Long

Private 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

Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" _
         (pBlock As Any, _
          ByVal lpSubBlock As String, _
          lplpBuffer As Long, _
          puLen As Long) As Long

Private Declare Sub MoveMemory Lib "kernel32.dll" Alias "RtlMoveMemory" _
  
         (Destination As Any, _
          Source As Any, _
          ByVal Length As Long)

Private Declare Function lstrcpy Lib "kernel32" Alias "lstrcpyA" _
         (ByVal lpString1 As String, _
          ByVal lpString2 As Long) As Long  '第二引数をLongに変更

Public Enum VERINFO_TYPE
    COMMENTS
    INTERNALNAME
    PRODUCTNAME
    COMPANYNAME
    LEGALCOPYRIGHT
    PRODUCTVERSION
    FILEDESCRIPTION
    LEGALTRADEMARKS
    PRIVATEBUILD
    FILEVERSION
    ORIGINALFILENAME
    SPECIALBUILD
End Enum

Private vmsFileName As String   'バージョン情報を取得するファイル名

'--------------------------------------------------------------------------
Public Sub SetFileName(argsFileName As String)
    vmsFileName = argsFileName
End Sub

'--------------------------------------------------------------------------
Public Function GetInfo(argeVerType As VERINFO_TYPE) As String
    Dim vlSize      As Long
    Dim vlZero      As Long
    Dim vlBuf()     As Byte
    Dim vlPointer   As Long
    Dim vlLen       As Long
    Dim vlRet       As Long
    Dim vlLangPage  As Long
    Dim vsSubBlock  As String
    Dim vsResult    As String

    '対象ファイル名のバージョン情報のサイズ取得
    vlSize = GetFileVersionInfoSize(vmsFileName, vlZero)
    If vlSize = 0 Then Exit Function

    'サイズ分のバッファ確保
    ReDim vlBuf(vlSize)

    'バージョン情報リソース取得(vlBuf()に取得)
    If GetFileVersionInfo(vmsFileName, 0&, vlSize, vlBuf(0)) = 0 Then
        Exit Function
    End If

    '言語固有の情報にアクセスの為の言語識別子/コードページ取得(vlPointerに取得)
    vlRet = VerQueryValue(vlBuf(0), "\VarFileInfo\Translation", vlPointer, vlLen)
    If vlRet = 0 Or vlPointer = 0 Then Exit Function
    
    'vlPointerはポインタなのでvlLangPageに移動
    MoveMemory vlLangPage, ByVal vlPointer, LenB(vlLangPage)

    '言語固有の情報の位置特定の文字列設定(VerQueryValueの第二引数で使用)
    vsSubBlock = "\StringFileInfo\" _
               & Right("0000" & LOWORD(vlLangPage), 4) _
               & Right("0000" & HIWORD(vlLangPage), 4) _
               & "\" & Choose(argeVerType + 1, _
                             "Comments", "InternalName", "ProductName", _
                             "CompanyName", "LegalCopyright", "ProductVersion", _
                             "FileDescription", "LegalTrademarks", "PrivateBuild", _
                             "FileVersion", "OriginalFilename", "SpecialBuild")

    'vlPointerに対象情報を取得
    vlRet = VerQueryValue(vlBuf(0), vsSubBlock, vlPointer, vlLen)
    If vlRet = 0 Or vlPointer = 0 Then Exit Function

    'vsResultにコピー
    vsResult = Space(vlLen)
    If lstrcpy(vsResult, vlPointer) = 0 Then Exit Function

    GetInfo = vsResult
End Function

'--------------------------------------------------------------------------
Private Function HIWORD(num As Long) As String
    HIWORD = Hex(CLng(num / &H10000))
End Function

'--------------------------------------------------------------------------
Private Function LOWORD(num As Long) As String
    LOWORD = Hex(num And &HFFFF&)
End Function

'標準モジュール //////////////////////////////////
Option Explicit

Public Sub test()
    Dim voFvi   As CFileVersionInfo
    Dim i       As Long
    Dim vvVit   As Variant

    vvVit = Array("Comments", "InternalName", "ProductName", _
                  "CompanyName", "LegalCopyright", "ProductVersion", _
                  "FileDescription", "LeagalTrademarks", "PrivateBuild", _
                  "FileVersion", "OriginalFilename", "SpecialBuild")

    Set voFvi = New CFileVersionInfo
    voFvi.SetFileName "C:\Windows\system32\notepad.exe"

    For i = COMMENTS To SPECIALBUILD
        With ThisWorkbook.Worksheets(1)
            .Cells(i + 1, 1) = vvVit(i)
            .Cells(i + 1, 2) = voFvi.GetInfo(i)
        End With
    Next i
End Sub