PDA

View Full Version : Operating System using Access VBA



highlowjack
07-22-2008, 08:48 AM
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
07-22-2008, 02:18 PM
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.

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 (http://www.tek-tips.com/faqs.cfm?fid=4599#) 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 (http://www.tek-tips.com/faqs.cfm?fid=4599#) 2003 family.


' Major Minor
' OS Platform Version Version Build
' Windows 95 1 4 0
' Windows 98 1 4 10 1998
' Windows 98SE (http://www.tek-tips.com/faqs.cfm?fid=4599#) 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 (http://www.tek-tips.com/faqs.cfm?fid=4599#), 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

highlowjack
07-24-2008, 05:52 AM
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
07-24-2008, 06:42 AM
Sigh.
You don't understand the code becuase its using Windows API calls.
http://msdn.microsoft.com/en-us/library/aa141683(office.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".

If getVersion = "Failed" Then (its probably Vista)



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?

Function GetOSfromExcel() As String

Dim objXLApp As Object


Set objXLApp = CreateObject("Excel.Application")

GetOSfromExcel = objXLApp.OperatingSystem

objXLApp.Quit
Set objXLApp = Nothing

End Function

Mavyak
07-24-2008, 07:06 AM
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

Dr.K
07-24-2008, 07:28 AM
Wow, I like the strings that your Function returns! Does it work with Vista?

Thank you for that. :thumb

Mavyak
07-24-2008, 02:30 PM
It does. I use Vista and that's what I tested it on.:wink:

strBean
05-07-2013, 11:46 AM
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

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
05-11-2013, 09:09 PM
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
07-18-2016, 11:46 AM
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