ExcelVBAで実行ファイルやdllのバージョンを取得する


ExcelVBAで、実行ファイルのバージョンを取得する必要があったので書いてみたコード。
x64版にもさりげなく対応させている。
x64版だと、APIの定義でPtrSafeキーワードを指定する必要があったり、ポインタサイズが64bitになることにより、特にハンドラの型をLongからLongPtrに変更する必要がある。

```vbnet
Option Explicit

#If VBA7 And Win64 Then

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

Private Declare PtrSafe Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" ( _
    ByVal lptstrFilename As String, _
    ByVal dwHandle As LongPtr, _
    ByVal dwLen As Long, _
    ByRef lpData As Any) As Long

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

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

#Else

Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" ( _
    ByVal lptstrFilename As String, _
    ByRef 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, _
    ByRef lpData As Any) As Long

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

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByRef Destination As Any, _
    ByRef Source As Any, _
    ByVal Length As Long)

#End If

Private Type VS_FIXEDFILEINFO
    dwSignature As Long
    dwStrucVersionl As Integer
    dwStrucVersionh As Integer
    dwFileVersionMSl As Integer
    dwFileVersionMSh As Integer
    dwFileVersionLSl As Integer
    dwFileVersionLSh As Integer
    dwProductVersionMSl As Integer
    dwProductVersionMSh As Integer
    dwProductVersionLSl As Integer
    dwProductVersionLSh As Integer
    dwFileFlagsMask As Long
    dwFileFlags As Long
    dwFileOS As Long
    dwFileType As Long
    dwFileSubtype As Long
    dwFileDateMS As Long
    dwFileDateLS As Long
End Type

Private Type FILEINFOOUT
    FileVersion As String
    ProductVersion As String
End Type

Public Sub GetVersion(ByVal path As String)

#If VBA7 And Win64 Then
    Dim handle As LongPtr
    Dim verPointer As LongPtr
#Else
    Dim handle As Long
    Dim verPointer As Long
#End If
    Dim size As Long
    Dim verBufLen As Long
    Dim fInfoOut As FILEINFOOUT
    Dim fileInfo As VS_FIXEDFILEINFO
    Dim buffer() As Byte
    
    size = GetFileVersionInfoSize(path, handle)
    If size = 0 Then
        GoTo ErrorHandler
    End If
    
    ReDim buffer(size)
    If Not CBool(GetFileVersionInfo(path, 0&, size, buffer(0))) Then
        GoTo ErrorHandler
    End If
    
    If Not CBool(VerQueryValue(buffer(0), "\", verPointer, verBufLen)) Then
        GoTo ErrorHandler
    End If
    
    Call CopyMemory(fileInfo, ByVal verPointer, Len(fileInfo))
    
    With fileInfo
    
        fInfoOut.FileVersion = _
            Format$(.dwFileVersionMSh) & "." & _
            Format$(.dwFileVersionMSl) & "." & _
            Format$(.dwFileVersionLSh) & "." & _
            Format$(.dwFileVersionLSl)
    
        fInfoOut.ProductVersion = _
            Format$(.dwProductVersionMSh) & "." & _
            Format$(.dwProductVersionMSl) & "." & _
            Format$(.dwProductVersionLSh) & "." & _
            Format$(.dwProductVersionLSl)
    
    End With
    
    Debug.Print "File Version: " & fInfoOut.FileVersion
    Debug.Print "Product Version: " & fInfoOut.ProductVersion
    
    Exit Sub
    
ErrorHandler:
    Debug.Print "Error!"
End Sub
```