VBA to log the office/excel version

pete4monc

Board Regular
Joined
Jan 12, 2014
Messages
80
Office Version
  1. 365
Platform
  1. Windows
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
 

Attachments

  • Screenshot 2022-11-04 090128.png
    Screenshot 2022-11-04 090128.png
    17.3 KB · Views: 5
  • Screenshot 2022-11-04 090309.png
    Screenshot 2022-11-04 090309.png
    39.7 KB · Views: 5

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
81,668
Office Version
  1. 365
Platform
  1. Windows
Just FYI the version is no longer accurate, all versions of Excel from 2016 onwards will return 16.0
 
Upvote 0

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
9,073
Office Version
  1. 2016
Platform
  1. Windows
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.

VBA Code:
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


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

Forum statistics

Threads
1,186,846
Messages
5,960,171
Members
438,464
Latest member
rangers277

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top