3

Can VBA detect the /3GB boot switch?

Microsoft have documented it here on MSDN and it's quite good, as MSDN pages go: they have explained what it is as well as how to use it.

This question is aimed at developers who use the #VBA7 and #Win64 compiler constants, and are comfortable with the API or WMI calls for reading Excel's public working set, and the memory available from the operating system.

The underlying question is: "Do I have the memory to perform this operation in one go"? and "How small will the chunks need to be if I break it up?"

The difficulty is that I cannot find any way of reading the available memory that detects the presence of the /3GB Boot switch.

Here's the code I'm using to read basic memory usage and availability:

Option Explicit
Option Private Module

Private Declare PtrSafe Function GetCurrentProcessId Lib "kernel32" () As Long

Public Function GetMemUsage()
' Returns the current Excel.Application memory usage in MB.

' This is the 'Working Set': it counts the memory footprint
' of shared Dlls. TaskMan displays the Private Working Set.

' Charles Williams explains Excel memory limits here:
'    http://www.decisionmodels.com/memlimitsc.htm
' Microsoft have some documentation:
'     https://support.microsoft.com/en-us/help/3066990/memory-usage-in-the-32-bit-edition-of-excel-2013-and-2016

Dim objSWbemServices As Object
Set objSWbemServices = GetObject("winmgmts:") ' WMI base class


With objSWbemServices.Get("Win32_Process.Handle='" & GetCurrentProcessId & "'")

    GetMemUsage = .WorkingSetSize / 1024

End With
Set objSWbemServices = Nothing

End Function

Public Function GetMemAvailable()
' Returns the current physical RAM available


Dim objSWbemServices As Object
Set objSWbemServices = GetObject("winmgmts:") ' WMI base class
Dim obj As Object


For Each obj In objSWbemServices.InstancesOf("Win32_OperatingSystem")

    With obj

        GetMemAvailable = .FreePhysicalMemory / 1024     

    End With

Next

End Function

...And That's pretty much all. I don't have anything that looks like a working 'Excel is nearly out of memory' warning; and no leads at all on the '/3GB' flag.

2
  • are you looking for something like this : WMIC /OUTPUT:C:\Temp\dump.txt path win32_process get Caption,Processid,Commandline ..... run this on command line and heck the command line column for all the switches (in the text file)
    – cyboashu
    Feb 5, 2018 at 15:29
  • 1
    There is at least one way of determining the upper end of the address space (which may be at 2GB, 3GB or 4GB): call VirtualAlloc with MEM_TOP_DOWN and see what range the result is in. I don't suggest this as a reliable technique -- specifically, if a lot of allocations have already been done the address you get back need not reflect the effective range -- but it would still be better than hunting for the /3GB boot option specifically. This is still not nearly the same thing as determining effective memory available before thrashing, but then, neither is looking for /3GB. Feb 5, 2018 at 15:31

1 Answer 1

7

See my blog post on LAA https://fastexcel.wordpress.com/2016/11/27/excel-memory-checking-tool-using-laa-to-increase-useable-excel-memory/

You can download my LAA memory checking tool which has all the Windows API calls to check Excel's available memory,

Code :

'
' 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
4
  • 1
    This is a working solution. I believe the downvote was due to link only answer. Added the code.
    – cyboashu
    Feb 5, 2018 at 15:54
  • Thanks @cyobashu -. I'm guessing that whoever downvoted this answer works in a corporate environment, where external executables and add-ins cannot be downloaded and run (or require a lengthy approval process with backing from senior managers before to get them on an 'approved' list with an internal msi)... Which seems ungracious, given that it's Charles Williams contributing a working solution. Feb 5, 2018 at 19:29
  • OK, I've tested this and it works on the environments available today. I will have access to a test box with the /3GB switch available tomorrow. Feb 5, 2018 at 19:31
  • Tested and reporting the memory correctly - Thank you both, Charles and Cyobashu Feb 5, 2018 at 21:04

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.