I have a procedure in Excel VBA that is causing an out of memory error. I’m trying to check memory usage as part of my ErrorHandler as well as take a snapshot of how far along execution has reached when the error is encountered.
I’ve found the following code that calls the Win API and provides the ‘Working Set Size’ memory but I also would like to check the Commit Size. Does anyone know what syntax I should use for the Commit Size?
I assume I need to change .WorkingSetSize with something else but I can’t find a reference and random tests with things like ‘CommitSize’ don’t work.
Thanks in advance.
Declare Function GetCurrentProcessId Lib "kernel32" () As Long Function GetWorkingSetSize() Dim objSWbemServices As Object ' Returns the current Excel.Application ' memory usage in MB Set objSWbemServices = GetObject("winmgmts:") GetWorkingSetSize = objSWbemServices.Get( _ "Win32_Process.Handle='" & _ GetCurrentProcessId & "'").WorkingSetSize / 1024 Set objSWbemServices = Nothing End Function
Function GetPctCommittedBytes() Dim colItems As Variant Dim objItem As Variant Set colItems = GetObject("WinMgmts:root/cimv2").ExecQuery("Select * FROM Win32_PerfFormattedData_PerfOS_Memory ") For Each objItem In colItems Debug.Print objItem.PercentCommittedBytesInUse Debug.Print objItem.CommittedBytes Next GetPctCommittedBytes = objItem.CommittedBytes End Function
H/T to THIS which pointed me in the right direction. I had to use the object browser to review the available properties for
To find out how much memory is available to VBA copy/paste the code below and call
Function allocateMB(intNumMB As Integer) As Boolean On Error Resume Next Dim a As Variant ReDim a(intNumMB, 256, 256) As Variant 'intNumMB x 256 x 256 x 16 bytes = intNumMB MB allocateMB = (Err.Number = 0) Err.Clear Erase a End Function Function availableMemoryInMB() As Integer Dim intLow As Integer, intHigh As Integer, intTest As Integer intTest = 1: intHigh = 0 Do If allocateMB(intTest) Then intLow = intTest If intHigh = 0 Then intTest = intTest * 2 Else intTest = (intLow + intHigh) / 2 End If Else intHigh = intTest intTest = (intLow + intHigh) / 2 End If Loop Until intHigh - intLow <= 1 And intHigh > 0 availableMemoryInMB = intLow End Function
Execution of the code takes 2-20 seconds.