none
Macro's memory usage unstable results RRS feed

  • Question

  • Hi

    I have a VBA Sub which starts with a call to GetCurrentProcessMemory and ends calling it again

    (the macro Sub runs within Outlook 2007  XP)

    I ran the Sub few times - please note the unstable results

    ' WorkingSetSize  137,015,296  ( Reference )
    ' WorkingSetSize  137,035,776  ( 20,480 )
    ' WorkingSetSize  137,089,024  ( Reference )
    ' WorkingSetSize  137,113,600  ( 24,576 )
    ' WorkingSetSize  137,117,696  ( Reference )
    ' WorkingSetSize  137,134,080  ( 16,384 )
    ' WorkingSetSize  137,146,368  ( Reference )
    ' WorkingSetSize  137,150,464  ( 4,096 )
    ' WorkingSetSize  137,486,336  ( Reference )
    ' WorkingSetSize  137,515,008  ( 28,672 )
    ' WorkingSetSize  137,498,624  ( Reference )
    ' WorkingSetSize  137,498,624  ( All Cleared )
    ' WorkingSetSize  137,498,624  ( Reference )
    ' WorkingSetSize  137,510,912  ( 12,288 )
    ' WorkingSetSize  137,502,720  ( Reference )
    ' WorkingSetSize  137,502,720  ( All Cleared )
    ' WorkingSetSize  137,646,080  ( Reference )
    ' WorkingSetSize  137,703,424  ( 57,344 )
    ' WorkingSetSize  137,797,632  ( Reference )
    ' WorkingSetSize  137,805,824  ( 8,192 )
    ' WorkingSetSize  137,764,864  ( Reference )
    ' WorkingSetSize  137,764,864  ( All Cleared )

    I would appreciate your support to get true stable results

    Here is GetCurrentProcessMemory code

    thanks

    Option Explicit
    '
    ' http://social.msdn.microsoft.com/Forums/eu/exceldev/thread/e3aefd82-ec6a-49c7-9fbf-5d57d8ef65ca
    '
    
    Type PROCESS_MEMORY_COUNTERS
       cb                         As Long
       PageFaultCount             As Long
       PeakWorkingSetSize         As Long
       WorkingSetSize             As Long
       QuotaPeakPagedPoolUsage    As Long
       QuotaPagedPoolUsage        As Long
       QuotaPeakNonPagedPoolUsage As Long
       QuotaNonPagedPoolUsage     As Long
       PagefileUsage              As Long
       PeakPagefileUsage          As Long
    End Type
    
    Private Const PROCESS_QUERY_INFORMATION = 1024
    Private Const PROCESS_VM_READ = 16
    
    Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
    Private Declare Function EnumProcessModules Lib "PSAPI.DLL" (ByVal hProcess As Long, lphModule As Long, ByVal cb As Long, lpcbNeeded As Long) As Long
    Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
    Private Declare Function GetProcessMemoryInfo Lib "PSAPI.DLL" (ByVal hProcess As Long, ppsmemCounters As PROCESS_MEMORY_COUNTERS, ByVal cb As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal Handle As Long) As Long
    
    
    Public Sub GetCurrentProcessMemory(Optional bInit As Boolean = False)
    
      Dim lngCBSize2           As Long
      Dim lngModules(1 To 200) As Long
      Dim lngReturn            As Long
      Dim lngHwndProcess       As Long
      Dim pmc                  As PROCESS_MEMORY_COUNTERS
      Dim lRet                 As Long
      Dim MemDelta             As Long
      Static MemUsed           As Long
    
      If bInit Then MemUsed = 0
    
     
      'Get a handle to the Process and Open
      lngHwndProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, GetCurrentProcessId)
    
      If lngHwndProcess <> 0 Then
    
          'Get an array of the module handles for the specified process
          lngReturn = EnumProcessModules(lngHwndProcess, lngModules(1), 200, lngCBSize2)
    
          If lngReturn <> 0 Then
             
             'Get the Site of the Memory Structure
              pmc.cb = LenB(pmc)
    
              lRet = GetProcessMemoryInfo(lngHwndProcess, pmc, pmc.cb)
    
              If bInit Then
                  Debug.Print "WorkingSetSize  " & Format(Fix(pmc.WorkingSetSize), "###,###,###") & "  ( Reference )"
                  MemUsed = pmc.WorkingSetSize
              Else
                  MemDelta = pmc.WorkingSetSize - MemUsed
                  If MemDelta > 0 Then
                     Debug.Print "WorkingSetSize  " & Format(Fix(pmc.WorkingSetSize), "###,###,###") & _
                                             "  ( " & Format(Fix(MemDelta), "###,###,###") & " )"
                  Else
                     Debug.Print "WorkingSetSize  " & Format(Fix(pmc.WorkingSetSize), "###,###,###") & "  ( All Cleared )"
                  End If
              End If
              
          End If
    
      End If
    
      'Close the handle to this process
      lngReturn = CloseHandle(lngHwndProcess)
    
    End Sub
    
    
    



    • Edited by BR99 Tuesday, April 24, 2012 7:07 PM
    Tuesday, April 24, 2012 5:21 PM