VB to find operating system

S

Scott R

Active Member
Joined
Feb 20, 2002
Messages
493
Office Version
  1. 365
Platform
  1. Windows
We're moving from Windows 7 Pro to Windows 10 Enterprise. I'd like code in my workbook to work under either environment, meaning I need to determine which environment a user is in and adapt my code accordingly.

Thoughts?
 

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
Sort by date Sort by votes
ENVIRON will tell you

Code: 
Sub ShowEnviron()
On Error Resume Next
For i = 1 To 100
Cells(i, 1) = Environ(i)
Next

End Sub
 
Last edited:
Upvote 0
Code: 
'
' COPYRIGHT © DECISION MODELS LIMITED 2016. All rights reserved
'
' Charles Williams 27 November 2016
'
Option Explicit
'
' WinApi declarations
'
#If VBA7 Then
    '
    Private Declare PtrSafe Function GlobalMemoryStatusEx Lib "Kernel32.dll" (ByRef lpBuffer As MEMORYSTATUSEX) As LongPtr
    Private Declare PtrSafe Sub CopyMemory Lib "Kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr)
    '
    '
    ' os version info
    '
    Declare PtrSafe Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long


Public Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128                      '  Maintenance string for PSS usage
End Type


' dwPlatforID Constants
Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
#Else
    '
    Private Declare Function GlobalMemoryStatusEx Lib "Kernel32.dll" (ByRef lpBuffer As MEMORYSTATUSEX) As Long
    Private Declare Sub CopyMemory Lib "Kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
    ' os version info
    '
    Public Declare Function GetVersionEx Lib "kernel32" Alias _
                                         "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long


Public Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128                      '  Maintenance string for PSS usage
End Type


' dwPlatforID Constants
Private Const VER_PLATFORM_WIN32s = 0
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2


#End If
'
'API Structures for status of memory
'
Private Type LARGE_INTEGER
    LowPart As Long
    HighPart As Long
End Type


Private Type MEMORYSTATUSEX
    dwLength As Long
    dwMemoryLoad As Long
    ullTotalPhys As LARGE_INTEGER
    ullAvailPhys As LARGE_INTEGER
    ullTotalPageFile As LARGE_INTEGER
    ullAvailPageFile As LARGE_INTEGER
    ullTotalVirtual As LARGE_INTEGER
    ullAvailVirtual As LARGE_INTEGER
    ullAvailExtendedVirtual As LARGE_INTEGER
End Type
Sub ShowExcelMemory()
'
' Find used and available Excel Virtual Mmory
'
    Dim MemStat As MEMORYSTATUSEX
    Dim dTotalVirt As Currency
    Dim dAvailVirt As Currency
    Dim dUsedVirt As Currency
    Dim lMB As Currency
    Dim strWindows As String
    Dim XL64 As String
    Dim jXLVersion As Long
    Dim nMajorVersion As Long
    Dim nBuildNumber As Long
    '
    lMB = 1048576
    '
    ' Windows version, build and bitness
    '
    strWindows = " 32 bit"
    If Len(Environ("PROGRAMFILES(x86)")) <> 0 Then strWindows = " 64 bit"
    strWindows = strWinVersion2(nMajorVersion, nBuildNumber) & " Build " & nBuildNumber & strWindows
    '
    ' Excel version, build and bitness
    '
    jXLVersion = Val(Application.Version)
    #If Win64 Then
        XL64 = strXLVersion(jXLVersion) & " Build " & CStr(Application.Build) & "64 bit"
    #Else
        XL64 = strXLVersion(jXLVersion) & " Build " & CStr(Application.Build) & " 32 bit"
    #End If
    '
    ' virtual memory used and maximum available
    '
    MemStat.dwLength = Len(MemStat)
    GlobalMemoryStatusEx MemStat
    '
    dTotalVirt = LargeIntToCurrency(MemStat.ullTotalVirtual) / lMB
    dAvailVirt = LargeIntToCurrency(MemStat.ullAvailVirtual) / lMB
    dUsedVirt = Round((dTotalVirt - dAvailVirt) / 1024, 2)
    dTotalVirt = Round(dTotalVirt / 1024, 2)
    '
    MsgBox strWindows & vbCrLf & XL64 & vbCrLf & vbCrLf & "Currently using " & CStr(dUsedVirt) & " GB of Virtual Memory" & vbCrLf & "Maximum Available is " & CStr(dTotalVirt) & " GB Virtual Memory", vbOKOnly + vbInformation, "Excel Virtual Memory Usage"
End Sub


Private Function LargeIntToCurrency(liInput As LARGE_INTEGER) As Currency
'copy 8 bytes from the large integer to an empty currency
    CopyMemory LargeIntToCurrency, liInput, LenB(liInput)
    'adjust it
    LargeIntToCurrency = LargeIntToCurrency * 10000
End Function
Function strWinVersion2(nMajorVersion As Long, nBuildNumber As Long) As _
         String
'
' Function to return the OS Version
'
    Dim tOSVer As OSVERSIONINFO
    Dim strSP As String


    ' First set length of OSVERSIONINFO
    ' structure size
    tOSVer.dwOSVersionInfoSize = Len(tOSVer)
    ' Get version information
    GetVersionEx tOSVer
    ' Determine OS type
    With tOSVer


        If .dwPlatformId = VER_PLATFORM_WIN32_NT Then
            ' This is an NT version (NT/2000/XP)


            If .dwMajorVersion = 5 Then
                Select Case .dwMinorVersion
                Case 0
                    strWinVersion2 = "Windows 2000 "
                Case 1
                    strWinVersion2 = "Windows XP "
                Case 2
                    strWinVersion2 = "Windows 2003 "
                Case Else
                    strWinVersion2 = "Windows NT " & .dwMajorVersion & "." & _
                                     .dwMinorVersion & " "
                End Select
            ElseIf .dwMajorVersion = 6 Then
                Select Case .dwMinorVersion
                Case 0
                    strWinVersion2 = "Windows Vista "
                Case 1
                    strWinVersion2 = "Windows 7 "
                Case 2
                    strWinVersion2 = "Windows 8 "
                Case Else
                    strWinVersion2 = "Windows 10 "
                End Select
            ElseIf .dwMajorVersion = 10 Then
                strWinVersion2 = "Windows 10 "
            Else
                strWinVersion2 = "Windows 10 "
            End If
        Else
            ' This is Windows 95/98/ME
            If .dwMajorVersion >= 5 Then
                strWinVersion2 = "Windows ME "
            ElseIf .dwMajorVersion = 4 And .dwMinorVersion > 0 Then
                strWinVersion2 = "Windows 98 "
            Else
                strWinVersion2 = "Windows 95 "
            End If
        End If
        nMajorVersion = .dwMajorVersion
        nBuildNumber = .dwBuildNumber
        'strSP = .szCSDVersion
        If Len(strSP) > 0 Then strWinVersion2 = strWinVersion2 & strSP
    End With
GoExit:
End Function
Function strXLVersion(jXLVersion As Long) As String
'
' convert the Excel version number to a string
'
    Select Case jXLVersion
    Case 8
        strXLVersion = "Excel 97"
    Case 9
        strXLVersion = "Excel 2000"
    Case 10
        strXLVersion = "Excel 2002"
    Case 11
        strXLVersion = "Excel 2003"
    Case 12
        strXLVersion = "Excel 2007"
    Case 14
        strXLVersion = "Excel 2010"
    Case 15
        strXLVersion = "Excel 2013"
    Case 16
        strXLVersion = "Excel 2016"
    Case Else
        strXLVersion = "Excel 20??"
    End Select


End Function
 
Upvote 0
Logit said:
Code: 
'
' COPYRIGHT © DECISION MODELS LIMITED 2016. All rights reserved
'
' Charles Williams 27 November 2016
'
Option Explicit
'
' WinApi declarations
'
[/QUOTE]

Thats a hell of a lot for PRINT "HELLO WORLD"
Click to expand...
 
Upvote 0
Some people like LOTS of code. I try to accommodate. :rofl:
 
Upvote 0
For you mole, I have this :

Code: 
Option Explicit


Sub fndOS()
    MsgBox "Microsoft Excel is using " & Application.OperatingSystem
End Sub


:eeek:
 
Upvote 0
mole999 said:
ENVIRON will tell you

Code: 
Sub ShowEnviron()
On Error Resume Next
For i = 1 To 100
Cells(i, 1) = Environ(i)
Next

End Sub
Click to expand...

How does this get me the Windows OS though? I like the simplicity but in row 20 of the output, it says "OS=Windows_NT" which is not the case. About Excel, System Info tells me the OS Name = "Microsoft Windows 7 Professional". That's what I'm after.
 
Upvote 0
Logit said:
For you mole, I have this :

Code: 
Option Explicit


Sub fndOS()
    MsgBox "Microsoft Excel is using " & Application.OperatingSystem
End Sub


:eeek:
Click to expand...

This provides the same answer as Mole's but a different answer from your more lengthy solution.
I like the answer from the lengthy solution though. Just trying to isolate the Windows version portion.
Thanks for the awesome code!
 
Upvote 0
.
This is more on target with what you are seeking :

Code: 
Sub test()
    Dim objWMI As Object
    Dim objSystems As Object
    Dim objOs As Object


    Set objWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set objSystems = objWMI.ExecQuery("Select * from Win32_OperatingSystem")


    For Each objOs In objSystems
        MsgBox "O/S Name : " & objOs.Caption & " / " & objOs.Version
    Next
    
    Set objOs = Nothing
    Set objSystems = Nothing
    Set objWMI = Nothing


End Sub
 
Upvote 0
Logit said:
For you mole, I have this :

Code: 
Option Explicit

Sub fndOS()
    MsgBox "Microsoft Excel is using " & Application.OperatingSystem
End Sub
Click to expand...
I am not sure how useful that is... I am using the 64-bit version of Window 8.1 but your code say I am using...

Windows (32-bit) NT 6.02
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Question Question
VB Mac/Windows advise
Replies
0
Views
314
Russk68
R
S
  • Question Question
Excel crashes when clicking object in the locals window od the VB Editor.
Replies
4
Views
258
Edgar_
Edgar_
M
  • Question Question
Excel Time Keeping "Application"
Replies
0
Views
564
Mrock1
M
D
  • Question Question
Tally that shifts cells daily.
Replies
3
Views
826
portews
P
C
  • Question Question
ole db CopyFromRecordset skipping cell values
Replies
0
Views
679
Clif McIrvin
C

Forum statistics

Threads
1,224,818
Messages
6,181,152
Members
453,021
Latest member
Justyna P

Share this page

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
Back
Top