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?
Thoughts?
'
' 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
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"
ENVIRON will tell you
Code:Sub ShowEnviron() On Error Resume Next For i = 1 To 100 Cells(i, 1) = Environ(i) Next End Sub
For you mole, I have this :
Code:Option Explicit Sub fndOS() MsgBox "Microsoft Excel is using " & Application.OperatingSystem End Sub
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
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...For you mole, I have this :
Code:Option Explicit Sub fndOS() MsgBox "Microsoft Excel is using " & Application.OperatingSystem End Sub