Operating System using Access VBA

[highlowjack]

How can I get the Operating System using Access VBA?

How can I determine if Access is running on XP or Vista?

In EXCEL it is the following (does NOT work in Access):
Application.OperatingSystem


Access has the following function:
Environ("OS")
However, This function returns "Windows NT" for BOTH XP and Vista.

[Dr.K]

Yeah, ENVIRON gives a crappy answer to that question. If you want a better answer, you need to hit up the Windows API.

I don't recall where I got this code, but its old enough that it does NOT include Vista. If you need to know specific versions of Vista, you'll have to fool around with it to figure out the missing constants. However, if you just need to know IsXP() as Boolean, then you could make a simple wrapper function for this code.

[vba]Option Explicit

Public Declare Function GetVersionExA Lib "kernel32" _
(lpVersionInformation As OSVERSIONINFO) As Integer

Public Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type

Public Const VER_PLATFORM_WIN32s = 0
' Win32s on Windows 3.1
Public Const VER_PLATFORM_WIN32_WINDOWS = 1
' Windows 95, Windows 98, or Windows Me
Public Const VER_PLATFORM_WIN32_NT = 2
' Windows NT, Windows 2000, Windows XP, or Windows Server 2003 family.


' Major Minor
' OS Platform Version Version Build
' Windows 95 1 4 0
' Windows 98 1 4 10 1998
' Windows 98SE 1 4 10 2222
' Windows Me 1 4 90 3000
' NT 3.51 2 3 51
' NT 2 4 0 1381
' 2000 2 5 0
' XP 2 5 1 2600
' Server 2003 2 5 2

Public Function getVersion() As String
Dim OSInfo As OSVERSIONINFO
Dim retvalue As Integer

OSInfo.dwOSVersionInfoSize = 148
OSInfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(OSInfo)

With OSInfo
Select Case .dwPlatformId
Case VER_PLATFORM_WIN32s ' Win32s on Windows 3.1
getVersion = "Windows 3.1"

Case VER_PLATFORM_WIN32_WINDOWS ' Windows 95, Windows 98,
Select Case .dwMinorVersion ' or Windows Me
Case 0
getVersion = "Windows 95"
Case 10
If (OSInfo.dwBuildNumber And &HFFFF&) = 2222 Then
getVersion = "Windows 98SE"
Else
getVersion = "Windows 98"
End If
Case 90
getVersion = "Windows Me"
End Select

Case VER_PLATFORM_WIN32_NT ' Windows NT, Windows 2000, Windows XP,
Select Case .dwMajorVersion ' or Windows Server 2003 family.
Case 3
getVersion = "Windows NT 3.51"
Case 4
getVersion = "Windows NT 4.0"
Case 5
Select Case .dwMinorVersion
Case 0
getVersion = "Windows 2000"
Case 1
getVersion = "Windows XP"
Case 2
getVersion = "Windows Server 2003"
End Select
End Select

Case Else
getVersion = "Failed"

End Select

End With
End Function
[/vba]

[highlowjack]

I was unable to understand what this code does.

I do not know how to use the code to determine if the OS is Vista.

This does not help.

[Dr.K]

Sigh.
You don't understand the code becuase its using Windows API calls.
http://msdn.microsoft.com/en-us/libr...ffice.10).aspx
http://visualbasic.about.com/od/usevb6/l/aa103002a.htm


To use this code:
1. Add a new code module to your project.
2. Paste in the above code.

You now have a public function "getVersion()" that returns a string telling you what the OS version is. Because the API constants have not updated, any OS after Server2003 will return "Failed".

[vba]If getVersion = "Failed" Then (its probably Vista)[/vba]



Then again, if you really have a hardon for the Excel .OperatingSystem property, you can still use it from Access...
You do know that you can use ANY other Office app from ANY Office VBA environment, right?

[vba]Function GetOSfromExcel() As String

Dim objXLApp As Object


Set objXLApp = CreateObject("Excel.Application")

GetOSfromExcel = objXLApp.OperatingSystem

objXLApp.Quit
Set objXLApp = Nothing

End Function[/vba]

[Mavyak]

[VBA]Function getOS() As String
Dim OS
For Each OS In GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
getOS = OS.Caption
Next OS
Set OS = Nothing
End Function[/VBA]

[Dr.K]

Wow, I like the strings that your Function returns! Does it work with Vista?

Thank you for that.

[Mavyak]

It does. I use Vista and that's what I tested it on.

[strBean]

[vba]Function getOS() As String
Dim OS
For Each OS In GetObject("winmgmts:").InstancesOf("Win32_OperatingSystem")
getOS = OS.Caption
Next OS
Set OS = Nothing
End Function[/vba]

Hi - Great stuff - just wondering if you know where I can see a list of properties, methods, etc., for the object model you're using here.

[shdestry]

It is much simpler to create an environment variable for your Access program to use. Computer->properties->Advanced->Environment Variables.

Under system variables New -> enter a variable name and value (i.e. "VISTA")

My variable is "Windows" and the answer is "Windows XT" or "Windows VISTA". As a switch between two diff computers with the same files and database (USB drive) occasionally some code needs to know which system it's on. This works well because the variable is specific to the computer not to the database.

It'd been more elegant if MS would allow you to just edit the "OS" variable.

[pstraton]

Here's an updated version that includes Windows Vista, 7 and 8:

Option Explicit
 
Public Declare Function GetVersionExA Lib "kernel32" (lpVersionInformation As OSVERSIONINFOEX) As Integer
 
Public Type OSVERSIONINFOEX
   dwOSVersionInfoSize As Long
   dwMajorVersion As Long
   dwMinorVersion As Long
   dwBuildNumber As Long
   dwPlatformId As Long
   szCSDVersion As String * 128
   
   wServicePackMajor As Integer
   wServicePackMinor As Integer
   wSuiteMask As Integer
   wProductType As Byte
   wReserved As Byte
End Type
     
Public Const VER_PLATFORM_WIN32s = 0
 ' Win32s on Windows 3.1
Public Const VER_PLATFORM_WIN32_WINDOWS = 1
 ' Windows 95, Windows 98, or Windows Me
Public Const VER_PLATFORM_WIN32_NT = 2
 ''Windows NT, Windows 2000, Windows XP, Windows Vista/7/8, or Windows Server 2003/2008 family.
 
 ' Major Minor
 ' OS Platform Version Version Build
 ' Windows 95 1 4 0
 ' Windows 98 1 4 10 1998
 ' Windows 98SE 1 4 10 2222
 ' Windows Me 1 4 90 3000
 ' NT 3.51 2 3 51
 ' NT 2 4 0 1381
 ' 2000 2 5 0
 ' XP 2 5 1 2600
 ' Server 2003 2 5 2
     
Public Function GetVersion() As String
    Const Failed As String = "Failed"
    
    Dim OSInfo As OSVERSIONINFOEX
    Dim retvalue As Integer

    OSInfo.dwOSVersionInfoSize = Len(OSInfo)
    OSInfo.szCSDVersion = Space$(128)
    retvalue = GetVersionExA(OSInfo)
     
    With OSInfo
        Select Case .dwPlatformId
        Case VER_PLATFORM_WIN32s  ' Win32s on Windows 3.1
            GetVersion = "Windows 3.1"
         
        Case VER_PLATFORM_WIN32_WINDOWS  ' Windows 95, Windows 98,
            Select Case .dwMinorVersion  ' or Windows Me
            Case 0
                GetVersion = "Windows 95"
            Case 10
                If (OSInfo.dwBuildNumber And &HFFFF&) = 2222 Then
                    GetVersion = "Windows 98SE"
                Else
                    GetVersion = "Windows 98"
                End If
            Case 90
                GetVersion = "Windows Me"
            Case Else
                GetVersion = Failed
            End Select
                 
        Case VER_PLATFORM_WIN32_NT      'Windows NT, Windows 2000, Windows XP, Windows Vista/7/8,
            Select Case .dwMajorVersion 'or Windows Server 2003/2008 family.
            Case 3
                GetVersion = "Windows NT 3.51"
            Case 4
                GetVersion = "Windows NT 4.0"
            Case 5
                Select Case .dwMinorVersion
                Case 0
                    GetVersion = "Windows 2000"
                Case 1
                    GetVersion = "Windows XP"
                Case 2
                    GetVersion = "Windows Server 2003"
                Case Else
                    GetVersion = Failed
                End Select
            Case 6
                Select Case .dwMinorVersion
                Case 0
                    If OSInfo.wProductType Then     '(1 vs 0 is True vs False in VB/VBA too)
                        GetVersion = "Windows Vista"
                    Else
                        GetVersion = "Windows Server 2008"
                    End If
                Case 1
                    If OSInfo.wProductType Then     '           "
                        GetVersion = "Windows 7"
                    Else
                        GetVersion = "Windows Server 2008 R2"
                    End If
                Case 2
                    GetVersion = "Windows 8"
                Case Else
                    GetVersion = Failed
                End Select
            Case Else
                GetVersion = Failed
            End Select
            
        Case Else
            GetVersion = Failed
        End Select
    End With
End Function

And another very useful function:

Function IsGEWindowsVersion(CheckVersion As String) As Variant
    '
    'Returns True if the Windows version under which this code is running is >= the specified check-version.  The
    'currently supported check-versions are:
    '
    '   "XP"
    '   "Vista"
    '   "7"
    '   "8"
    '
    'Note that "Windows Server 2003" is considered to be >= "XP", "Windows Server 2008" is considered to
    'be >= "Vista", and "Windows Server 2008 R2" is considered to be >= "7".
    '
    'To add additional check-versions, refer to the GetVersion function's code.
    '
    '*************************************************************************************************************
    
    Dim OSInfo As OSVERSIONINFOEX
    Dim retvalue As Integer

    OSInfo.dwOSVersionInfoSize = Len(OSInfo)
    OSInfo.szCSDVersion = Space$(128)
    retvalue = GetVersionExA(OSInfo)
     
   'If retvalue = 1 Then    'GetVersionExA fails only if you mess up its passed argument
        With OSInfo
            If .dwPlatformId >= VER_PLATFORM_WIN32_NT Then
                Select Case CheckVersion
                Case "XP"
                    IsGEWindowsVersion = Not (.dwMajorVersion < 5 Or .dwMajorVersion = 5 And .dwMinorVersion < 1)
                Case "Vista"
                    IsGEWindowsVersion = .dwMajorVersion > 6 Or .dwMajorVersion = 6 And .dwMinorVersion >= 0
                Case "7"
                    IsGEWindowsVersion = .dwMajorVersion > 6 Or .dwMajorVersion = 6 And .dwMinorVersion >= 1
                Case "8"
                    IsGEWindowsVersion = .dwMajorVersion > 6 Or .dwMajorVersion = 6 And .dwMinorVersion >= 2
                End Select
            End If
        End With
    'Else
      '    IsGEWindowsVersion = CVErr(2001)    'NOTE: To handle user-defined error, assign to a Variant and
      '                                        'use IsError to check results.
   'End If
End Function