When troubleshooting various issues, one of the common thing one does is try to get some information about the PC itself. Things like:
- OS
- MS Office
It can be difficult at time to get such information from users depending on their skill level and as such, a while back I had post in a forum a function which use WMI to get the OS name and version. I took my old function and cleaned it up and provide it below should you wish to be able to easily determine your users’ OS easily.
'---------------------------------------------------------------------------------------
' Procedure : getOperatingSystem
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Return the active OS details
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
' (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sHost : Name/IP Address of the PC to query assuming you have the rights to do so
' optional, so by leaving it blank it will query the local computer
'
' Usage:
' ~~~~~~
' ? getOperatingSystem() -> Microsoft Windows 7 Ultimate 6.1.7601 (64-bit)
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2012-09-27 Initial Release
' 2 2016-09-24 Code Cleanup and standardization
' 3 2018-08-30 Added OS bitness to returned value
' Updated Copyright
'---------------------------------------------------------------------------------------
Public Function getOperatingSystem(Optional sHost As String = ".") As String
'Win32_OperatingSystem -> https://msdn.microsoft.com/en-us/library/aa394239%28v=vs.85%29.aspx
On Error GoTo Error_Handler
Dim oWMI As Object 'WMI object to query about the PC's OS
Dim oOSs As Object 'Collection of OSs
Dim oOS As Object 'Individual OS
Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sHost & "\root\cimv2")
Set oOSs = oWMI.ExecQuery("SELECT Caption, Version, OSArchitecture FROM Win32_OperatingSystem")
For Each oOS In oOSs 'Enumerate each OS provided by WMI
getOperatingSystem = getOperatingSystem & oOS.Caption & " " & oOS.Version & _
" (" & oOS.OSArchitecture & "), "
Next
getOperatingSystem = Left(getOperatingSystem, Len(getOperatingSystem) - 2) 'Remove the last ", "
Error_Handler_Exit:
On Error Resume Next
If Not oOS Is Nothing Then Set oOS = Nothing
If Not oOSs Is Nothing Then Set oOSs = Nothing
If Not oWMI Is Nothing Then Set oWMI = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: getOperatingSystem" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
If you have some type of global error handler, this could be a valuable piece of information to include as part of the error reporting process.
It might be helpful to add 32/64bit to the output.
Very valid point. If I have some time, I’ll see what I can do to add such information to the function.
Well …
‘—————————————————————————————
‘ Procedure : getOperatingSystem
‘ Author : Daniel Pineault, CARDA Consultants Inc.
‘ Website : http://www.cardaconsultants.com
‘ Purpose : Return the active OS details
‘ Copyright : The following may be altered and reused as you wish so long as the
‘ copyright notice is left unchanged (including Author, Website and
‘ Req’d Refs: Uses Late Binding, so none required
‘
‘ Input Variables:
‘ ~~~~~~~~~~~~~~~~
‘ sHost : Name/IP Address of the PC to query assuming you have the rights to do so
‘ optional, so by leaving it blank it will query the local computer
‘
‘ Usage:
‘ ~~~~~~
‘ ? getOperatingSystem() -> Microsoft Windows 7 Ultimate 6.1.7601
‘
‘ Revision History:
‘ Rev Date(yyyy/mm/dd) Description
‘ **************************************************************************************
‘ 1 2012-09-27 Initial Release
‘ 2 2016-09-24 Code Cleanup and standardization
‘—————————————————————————————
Public Function getOperatingSystem(Optional sHost As String = “.”) As String
‘Win32_OperatingSystem -> https://msdn.microsoft.com/en-us/library/aa394239%28v=vs.85%29.aspx
On Error GoTo Error_Handler
Dim oWMI As Object ‘WMI object to query about the PC’s OS
Dim oOSs As Object ‘Collection of OSs
Dim oOS As Object ‘Individual OS
Dim bIs64BitWin As Boolean
Dim strSys32or64 As String
bIs64BitWin = Is64BitWin()
If bIs64BitWin Then
strSys32or64 = ” 64 bit ”
Else
strSys32or64 = ” 32 bit ”
End If
Set oWMI = GetObject(“winmgmts:{impersonationLevel=impersonate}!\\” & sHost & “\root\cimv2”)
Set oOSs = oWMI.ExecQuery(“Select Caption, Version from Win32_OperatingSystem”)
For Each oOS In oOSs ‘Enumerate each OS provided by WMI
getOperatingSystem = getOperatingSystem & oOS.Caption & strSys32or64 & ” ” & oOS.Version & “, ”
Next
getOperatingSystem = Left(getOperatingSystem, Len(getOperatingSystem) – 2) ‘Remove the last “, ”
Error_Handler_Exit:
On Error Resume Next
Set oOS = Nothing
Set oOSs = Nothing
Set oWMI = Nothing
Exit Function
Error_Handler:
MsgBox “The following error has occured.” & vbCrLf & vbCrLf & _
“Error Number: ” & err.Number & vbCrLf & _
“Error Source: getOperatingSystem” & vbCrLf & _
“Error Description: ” & err.Description, _
vbCritical, “An Error has Occured!”
Resume Error_Handler_Exit
End Function
‘ Prüft, ob ein 32-Bit oder 64-Bit Windows-System ausgeführt wird
‘ Author: http://www.vbarchiv.net/tipps/tipp_2274-handelt-es-sich-um-ein-32-bit-oder-um-ein-64-bit-windows-system.html
Public Function Is64BitWin() As Boolean
Dim oWMI As Object
Dim oItems As Object
Dim oItem As Object
‘ Fehelrbehandlung
On Error GoTo ErrHandler
‘ WMI-Objekt erstellen
Set oWMI = GetObject(“winmgmts:\\.\root\CIMV2”)
‘ System-Daten auslesen
Set oItems = oWMI.ExecQuery(“SELECT * FROM Win32_ComputerSystem”)
For Each oItem In oItems
Is64BitWin = (InStr(1, oItem.SystemType, “64-bit”, vbTextCompare) > 0 _
Or InStr(1, oItem.SystemType, “x64”, vbTextCompare) > 0)
Next
On Error GoTo 0
ErrHandler:
‘ Objekte freigeben
Set oItem = Nothing
Set oItems = Nothing
Set oWMI = Nothing
End Function
regards Klaus
I’ve been using a very similar function from StackOverflow to get a nice verbose description of the Windows OS version (like “Microsoft Windows 10 Enterprise (10.0.19042) 64-bit”). Recently some antivirus programs have started blocking the WMI Scripting Library which is called by GetObject(“winmgmts”); not only blocking this, but terminating the parent application (Excel) when it is called.
Is there an alternative, perhaps querying the registry or using Windows APIs?
You may be able to get around it by using PowerShell, see How to Get Windows OS Information Using VBA
I found my build no in the HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Flighting\Build reg key, so perhaps you could grab it by directly reading the registry.
Never mind. I have come up with this:
Function GetWindowsInfo() As String
Dim oShell As Object
Set oShell = CreateObject(“WScript.Shell”)
Dim RegKeyProduct As String
RegKeyProduct = “HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProductName”
Dim ProductName As String
ProductName = oShell.RegRead(RegKeyProduct)
Dim RegKeyMajor As String
RegKeyMajor = “HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentMajorVersionNumber”
Dim RegKeyMinor As String
RegKeyMinor = “HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentMinorVersionNumber”
Dim Version As String
Version = oShell.RegRead(RegKeyMajor) & “.” & oShell.RegRead(RegKeyMinor)
Dim RegKeyBuild As String
RegKeyBuild = “HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\CurrentBuildNumber”
Dim RegKeyUBR As String
RegKeyUBR = “HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\UBR”
Dim BuildNumber As String
BuildNumber = oShell.RegRead(RegKeyBuild) & “.” & oShell.RegRead(RegKeyUBR)
Dim Bitness As String
Bitness = “32-bit”
If Len(Environ(“PROGRAMFILES(x86)”)) Then Bitness = “64-bit”
GetWindowsInfo = “Microsoft ” & ProductName & ” (” & Version & “.” & BuildNumber & “) ” & Bitness
End Function