How to retrieve Operating System Information using Excel/Word VBA
The version information of OS can be retrieved using the WIN API functions given below
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Declare Function GetVersionEx Lib "kernel32" _
Alias "GetVersionExA" (lpVersionInformation As _
OSVERSIONINFO) As Long
The following sub uses GetVersionEx function to get the Major and Minor version of OS
Sub Get_OS_Version_VBA() ' ------------------------------------------------------------- ' Code to Get Version of Operating System through VBA ' ------------------------------------------------------------- Dim oOSInfo As OSVERSIONINFO oOSInfo.dwOSVersionInfoSize = Len(oOSInfo) GetVersionEx oOSInfo ' ------------------------------------------------------------- ' Coded for http://vbadud.blogspot.com ' ------------------------------------------------------------- MsgBox "Version of Current OS is " & oOSInfo.dwMajorVersion & "." & oOSInfo.dwMinorVersion End Sub
Posts
In VB 2010 express you can't use Private Type OSVERSIONINFO
ReplyDeleteit has to be declared as a structure.
How do you define those with out using a type?
Same question! Anyone know?
ReplyDeleteInstead of Private Type OSVERSIONINFO try Private Structure OSVERSIONINFO
ReplyDeletePublic Function DirExists(pathName As String) As Boolean
ReplyDeleteDim oFSO As New FileSystemObject
DirExists = oFSO.FolderExists(pathName)
End Function
If DirExists("C:\Program Files (x86)\.") Then
a_Folder = Environ$("ProgramData")
Else
a_Folder = Environ$("ALLUSERSPROFILE")
End If
Here is an easy way to distinguish between Windows XP and Windows 7.
'***********************************************************************************************************************
Delete' Navn : GetOSName
' Version : 1.0
' Dato : 30-09-2014
' Inparam : -
' Outparam : OS
' Beskrivelse : Finder og returnerer windows version
' TODO : -
'***********************************************************************************************************************
Public Function GetOSName()
On Error GoTo Fejl
Dim ObjWMIservice As Object, ColItems As Object, ObjItem As Object
Set ObjWMIservice = GetObject("winmgmts:\\.\root\cimv2")
Set ColItems = ObjWMIservice.ExecQuery("SELECT * FROM Win32_OperatingSystem", , 48)
For Each ObjItem In ColItems
GetOSName = ObjItem.Name
Next
GetOSName = Left(GetOSName, InStr(GetOSName, "|") - 1)
GetOSName = Trim(MID(GetOSName, InStr(15, GetOSName, " "), 4))
Select Case GetOSName
Case 10: GetOSName = 10
Case 8.1: GetOSName = 8
Case 7.1, 7: GetOSName = 7
Case Else: GetOSName = 5
End Select
Set ObjItem = Nothing
Set ColItems = Nothing
Set ObjWMIservice = Nothing
ExitHer:
Exit Function
Fejl:
MsgBox Err.Description, , ""
Resume ExitHer
End Function