Monday, July 11, 2011

Getting windows version & os, from VBA

Hi all.
Im using Vba a lot, as a cad modifying tool, and one of the limitations i run in to, is in installing the right printer / pdf drivers, to get everything working in THIS particular version of windows.
There are different drivers for xp/xp64/7/7_64 and so on.
Therefore i cobbled this together from different sources

Sub testGetOs()
MsgBox GetOS
End Sub


Function GetOS()
'Will work with most versions of WSH.
'CMD window will not display.
Const OpenAsASCII = 0
Const FailIfNotExist = 0
Const ForReading = 1

Dim WshShell: Set WshShell = CreateObject("WScript.Shell")
Dim FSO: Set FSO = CreateObject("Scripting.FileSystemObject")
Dim sTemp, sTempFile, fFile, sResults
sTemp = WshShell.ExpandEnvironmentStrings("%TEMP%")
sTempFile = sTemp & "\runresult.tmp"

WshShell.Run "%comspec% /c ver >" & sTempFile, 0, True

Set fFile = FSO.OpenTextFile(sTempFile, ForReading, FailIfNotExist, OpenAsASCII)

sResults = fFile.ReadAll
fFile.Close
FSO.DeleteFile (sTempFile)
Select Case True

'Add more info to the 98 and 95 to get the specific version. i.e. 98SE 95 a,b,or c
Case InStr(sResults, "Windows 95") > 1: GetOS = "W95"
Case InStr(sResults, "Windows 98") > 1: GetOS = "W98"
Case InStr(sResults, "Windows Millennium") > 1: GetOS = "WME"
Case InStr(sResults, "Windows NT") > 1: GetOS = "NT4"
Case InStr(sResults, "Windows 2000") > 1: GetOS = "W2K"
Case InStr(sResults, "5.2") > 1: GetOS = "XP " + AmI32Or64
Case InStr(sResults, "6.1") > 1: GetOS = "7 " + AmI32Or64
Case Else: GetOS = "Unknown"
End Select
End Function


Function AmI32Or64()

On Error Resume Next

Dim WshShell
Dim OsType

Set WshShell = CreateObject("WScript.Shell")

OsType = WshShell.RegRead("HKLM\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\PROCESSOR_ARCHITECTURE")

If OsType = "x86" Then
AmI32Or64 = "32 bit"
ElseIf OsType = "AMD64" Then
AmI32Or64 = "64 bit"
End If
On Error GoTo 0
End Function

This will show what kind of windows Os your running.
I got some of the code from here
and some more here
Enjoy

Labels: