VBA to log the office/excel version

[pete4monc]

Hi all
We share an excel spreadsheet between multiple departments and I have some vba which records every time someone opens and closes the work book (computer name, date and time).
This works absolutely fine. But recently have had instances where different cell formats have changed? Of course everyone denies doing it.....lol.
But it could possibly be different versions of excel causing issues?

I would like to add to my vba, some code that will also record the version of microsoft office/excel that they are using when they open that workbook.
Is this possible, has anyone manged to do this, as I have read all sorts on the internet that it can not be done?

Many thanks for your help.
Pete

 

[Craggs82]

Application.Version
Application.OperatingSystem

 

[pete4monc]

Application.Version
Application.OperatingSystem

Hi Craggs

Works a treat. Thanks

 

[Fluff]

Just FYI the version is no longer accurate, all versions of Excel from 2016 onwards will return 16.0

 

[Jaafar Tribak]

The following api alternative function "GetFileVersion" returns the correct Major,Minor,Revision and Build values.
I haven't tested it on versions of excel subsequent to excel 2016 so I am not sure if it fixes the issue described by @Fluff. I would love to know.

Option Explicit

Private 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

#If VBA7 Then
    Private Declare PtrSafe Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByVal Source As Any, ByVal Length As LongPtr)
    Private Declare PtrSafe Function GetFileVersionInfoSizeW Lib "version.dll" (ByVal lptstrFilename As LongPtr, Optional ByRef lpdwHandle As Long) As Long
    Private Declare PtrSafe Function GetFileVersionInfoW Lib "version.dll" (ByVal lptstrFilename As LongPtr, ByVal dwHandle As LongPtr, ByVal dwLen As Long, ByRef lpData As Any) As Long
    Private Declare PtrSafe Function VerQueryValueW Lib "version.dll" (ByRef pBlock As Any, ByVal lpSubBlock As LongPtr, ByRef lplpBuffer As LongPtr, ByRef puLen As Long) As Long
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByVal Source As Any, ByVal Length As LongPtr)
    Private Declare Function GetFileVersionInfoSizeW Lib "version.dll" (ByVal lptstrFilename As LongPtr, Optional ByRef lpdwHandle As Long) As Long
    Private Declare Function GetFileVersionInfoW Lib "version.dll" (ByVal lptstrFilename As LongPtr, ByVal dwHandle As LongPtr, ByVal dwLen As Long, ByRef lpData As Any) As Long
    Private Declare Function VerQueryValueW Lib "version.dll" (ByRef pBlock As Any, ByVal lpSubBlock As LongPtr, ByRef lplpBuffer As LongPtr, ByRef puLen As Long) As Long
#End If

Function GetFileVersion(ByVal sFile As String) As String
    Dim sBuff() As Byte, dwLen As Long, lBufPtr As LongPtr, tFFI As VS_FIXEDFILEINFO

    dwLen = GetFileVersionInfoSizeW(StrPtr(sFile))
    If dwLen Then
        ReDim sBuff(0& To dwLen - 1&) As Byte
        If GetFileVersionInfoW(StrPtr(sFile), 0&, dwLen, sBuff(0&)) Then
            If VerQueryValueW(sBuff(0&), StrPtr("\"), lBufPtr, dwLen) Then
                CopyMemory tFFI, lBufPtr, dwLen
                With tFFI
                    GetFileVersion = (.dwFileVersionMS \ &H10000) & _
                    "." & (.dwFileVersionMS And &HFFFF&) & _
                    "." & (.dwFileVersionLS \ &H10000) & _
                    "." & (.dwFileVersionLS And &HFFFF&)
                End With
            End If
        End If
    End If
End Function

Sub Test()
    With Application
        MsgBox "Version: " & GetFileVersion(.Path & .PathSeparator & "excel.exe")
    End With
End Sub