Excel 内存不足错误-尝试使用Win API检查ErrorHandler中的内存使用情况

我在Excel VBA中有一个过程导致内存不足错误。我试图在ErrorHandler中检查内存使用情况，并在遇到错误时拍摄执行时间的快照

我发现下面的代码调用WinAPI并提供“工作集大小”内存，但我也想检查提交大小。有人知道我应该使用什么语法来表示提交大小吗

我想我需要改变。WorkingSetSize与其他东西一起工作，但我找不到引用，而像“CommitSize”这样的随机测试不起作用

提前谢谢

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为我指明了正确的方向。我必须使用对象浏览器查看

objItem

的可用属性：

---

要了解VBA有多少可用内存，请复制/粘贴下面的代码，然后调用

availableMemoryInMB（）

函数将EMB（intNumMB作为整数）分配为布尔值
出错时继续下一步
变暗作为变体
将a（intNumMB，256，256）作为变量“intNumMB x 256 x 256 x 16字节=intNumMB MB
allocateMB=（Err.Number=0）
呃，明白了
抹掉
端函数
函数availableMemoryInMB（）为整数
Dim intLow为整数，intHigh为整数，intTest为整数
intTest=1:intHigh=0
做
如果分配EMB（intTest），则
intLow=intTest
如果intHigh=0，则
intTest=intTest*2
其他的
intTest=（intLow+intHigh）/2
如果结束
其他的
intHigh=intTest
intTest=（intLow+intHigh）/2
如果结束
循环直到intHigh-intLow 0
availableMemoryInMB=intLow
端函数

---

代码的执行需要2-20秒

谢谢你。这确实返回了信息，但我还不能理解它指的是什么。这是否为运行的所有内容提供了提交大小？如果是这样的话，你知道我是如何引用excel.exe的吗？我相信这就是运行的一切。XL的提交大小可能不是问题的根源…谢谢。半夜我想检查TaskManager性能选项卡（我在Win7中），这个调用的结果与提交大小几乎相同。谢谢我对内存分配知之甚少，所以我相信您关于XL提交大小不是一个因素的看法是正确的。目前我正在四处寻找，希望能找到一些能给我问题线索的东西。没问题。我对此也知之甚少，但我对VBA非常精通，对WinAPI也有一点了解，而且我对谷歌很在行，能够给出这样的答案：）。我之所以这样说是因为XL提交大小不太可能帮助您诊断问题。我有限的理解是，这只是代码中某些潜在问题的症状。或者至少那是我开始寻找的第一个地方。祝你好运如果这已经回答了你的问题，请考虑接受它，或者如果它有助于进一步理解你的投票，我确实接受了你的代码作为答案。再次感谢。如果您知道如何检查特定于流程的提交大小，我将不胜感激。

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