VBAで全体のメモリ使用量と特定アプリの使用メモリを取得し記録する

全体のメモリ使用量だけならネット界隈に情報があるが、特定アプリについて薄い

　VBAを利用してPC全体としてのメモリ使用量と特定のアプリケーション（ソフトウェア）のメモリ使用量を一定時間ごとに取得し続けるものを作成したい。特定アプリについてはいい方法がなさそうだったので、ネットでの情報をかいつまみつつ自作することにした。PC全体のメモリ使用量の取得については大体以下のサイトを参照にした。

Microsoft Excel VBA - メモリーの使用状況を表示する

メモリーの使用状況を表示する方法です。

MEMORYSTATUSEXを利用する。問題は特定アプリケーションのメモリ取得。ずいぶんと手間がかかり、バッチファイルで値を取得しcsvに記録し、そのcsvをExcelに取り込むことで記録していく。同期をとるためにWshShellを利用し、バッチの動作終了を待って次の行に進む（どのみち待ち時間があるんで大丈夫とは思いますが）
　WshShellの利用には参照設定でWindows Script Host Object Modelにチェックを入れる。下のコード65行目の値で取得間隔を変更する。

Private Type MEMORYSTATUSEX
     dwLength As Long               ' MEMORYSTATUSの大きさ
     dwMemoryLoad As Long           ' 使用中メモリの割合
     ullTotalPhys As Currency       ' 全物理メモリ
     ullAvailPhys As Currency       ' 空き物理メモリ
     ullTotalPageFile As Currency   ' ページング可能な最大ファイルサイズ
     ullAvailPageFile As Currency   ' 現在ページング可能なファイルサイズ
     ullTotalVirtual As Currency    ' 最大仮想メモリ
     ullAvailVirtual As Currency    ' 現在使用可能な仮想メモリ
     ullAvailExtendedVirtual As Currency
 End Type

Private Declare Function GlobalMemoryStatusEx _
     Lib "kernel32" (mseStatus As MEMORYSTATUSEX) As Long
     
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)



Sub RunBatWshShell2()

    Dim dMemoryLoad As Double       ' メモリ使用率
    Dim dTotPhys As Double          ' 全物理メモリ
    Dim dAvailPhys As Double        ' 利用可能メモリ
    Dim dTotalPageFile As Double    ' ページング可能な最大ファイルサイズ
    Dim dAvailPageFile As Double    ' 現在ページング可能なファイルサイズ
    Dim dTotalVirtual As Double     ' 最大仮想メモリ
    Dim dAvailVirtual As Double     ' 現在使用可能な仮想メモリ
    
    Dim res As Long
  
    Dim MemStat As MEMORYSTATUSEX
    
    Dim obj As New WshShell
    Dim sPath
    Dim mPath
    Dim tmp As Variant
    Dim buf  As String
    Dim d
    Dim i
    Dim mem
    Dim mem2
    Dim Starttime
    Dim Endtime As Long
    
    
    i = 2
    
    While Cells(i, 1) <> ""
    
        
            i = i + 1
        
    Wend
        
    
    d = ThisWorkbook.Path
    
    sPath = d & "\" & "testmem.bat"
    mPath = d & "\" & "testmem.csv"
    
    
    While True
        Starttime = Now
        Endtime = 5　'取得間隔を秒数で指定
        
            While Int(DateDiff("s", Starttime, Now)) < Endtime
                
                Sleep 1
        
                DoEvents

            Wend
            
            Set obj = New WshShell
                    
            Call obj.Run(sPath, 0, WaitOnReturn:=True)
            
            Set obj = Nothing
            
            Open mPath For Input As #1
            Do Until EOF(1)
                    Line Input #1, buf
                    
            Loop
            Close #1
            
            tmp = Split(buf, ",")
            tmp(4) = Right(tmp(4), Len(tmp(4)) - 1)
            mem = ((tmp(4) & Left(tmp(5), 3)))
            
            Cells(i, 1) = Now
            
            Cells(i, 2) = mem
            
            
            MemStat.dwLength = Len(MemStat)
            res = GlobalMemoryStatusEx(MemStat)
            dMemoryLoad = MemStat.dwMemoryLoad          ' メモリ使用率
            dTotPhys = MemStat.ullTotalPhys * 10000&    '/ (1024& * 1024)'全物理メモリ
            dAvailPhys = MemStat.ullAvailPhys * 10000&  ' 利用可能メモリ
            
            
            mem2 = Format((dTotPhys - dAvailPhys) / (1024), "###0")
            
            Cells(i, 3) = mem2
            Cells(i, 4) = dMemoryLoad & "%"
            i = i + 1
    Wend
   
End Sub

対応するバッチファイルを作成する必要がある。上記コードでは59行目でtestmem.batと指定しているため、その名前で同じ階層内にバッチファイルを作成する。

@echo off  
cd /d %~dp0
tasklist /fi "imagename eq EXCEL.EXE" /fo csv /NH >> testmem.csv

バッチが動くたびにtestmem.csvにEXCEL.EXEのメモリ使用量が記録され、最新の行をVBAが取得する動作となる。バッチファイルの中のEXCEL.EXEを別のアプリケーションの名前にすることで、好きなアプリケーションのメモリ使用量を取得することができる。