IE操作中にオブジェクトのメモリが異常に膨れる場合の対応

2020年6月28日 VBA スクレイピング

Excel VBAで繰り返しIEを操作していると、IEオブジェクトの使っているメモリ領域が異常に膨れることがある。 それも、どういうわけか特定のサイトを操作している時に限ってだ。 原因は不明だが、この状況に陥るとExcelが固まってしまい、タスクマネージャーから強制終了するしかなくなる。

とりあえずの対策として、ブラウザの操作回数をカウントして一定の回数に達したら一度ブラウザを再起動して続きを行うようにしていた。 ずっとそれで対応してきたが、やはり無駄な再起動は控えたいので、プロセスが確保しているメモリ量を取得して、これが一定のサイズに達したら再起動するような方法に変えることにした。

WMIを使ってプロセス情報を取得する。 WMIで取得できる値を確認するため、試しに以下コードを実行してみた。 IEを操作しているので、IEのプロセス情報だけ表示するようにした。

Sub test()

    Dim WMI As Object
    Set WMI = CreateObject("WbemScripting.SWbemLocator")

    Dim oService As Object
    Set oService = WMI.ConnectServer

    Dim oClassSet As Object
    Set oClassSet = oService.ExecQuery("SELECT * FROM Win32_Process")

    Dim oClass As Object
    DEV_MODE = True
    For Each oClass In oClassSet
        If oClass.Caption = "iexplore.exe" Then
            Debug.Print "Caption：" & oClass.Caption
            Debug.Print "CommandLine：" & oClass.commandLine
            Debug.Print "Handle：" & oClass.Handle
            Debug.Print "PageFaults：" & oClass.PageFaults
            Debug.Print "PageFileUsage：" & oClass.PageFileUsage
            Debug.Print "PeakPageFileUsage：" & oClass.PeakPageFileUsage
            Debug.Print "PrivatePageCount：" & oClass.PrivatePageCount
            Debug.Print "ProcessId：" & oClass.ProcessID
            Debug.Print "WorkingSetSize：" & oClass.WorkingSetSize
            Debug.Print ""
        End If
    Next

    Set oClass = Nothing
    Set oClassSet = Nothing
    Set oService = Nothing
    Set WMI = Nothing
End Sub

実行結果は以下。

Caption：iexplore.exe
CommandLine："C:\Program Files\Internet Explorer\iexplore.exe"
Handle：4908
PageFaults：14549
PageFileUsage：9172
PeakPageFileUsage：11008
PrivatePageCount：9392128
ProcessId：4908
WorkingSetSize：38666240

Caption：iexplore.exe
CommandLine："C:\Program Files (x86)\Internet Explorer\IEXPLORE.EXE" SCODEF:4908 CREDAT:17410 /prefetch:2
Handle：9112
PageFaults：177431
PageFileUsage：95496
PeakPageFileUsage：100440
PrivatePageCount：97787904
ProcessId：9112
WorkingSetSize：133042176

この時のタスクマネージャーの表示は以下。

プログラムの出力結果のWorkingSetSizeと、タスクマネージャーのワーキングセット（メモリ）が近い値（ 133042176 ÷ 1024 = 129,924 ）なので、同じ意味と思われる。

上の結果を参考に、IEプロセスの使用メモリを合計してその値を戻す関数を作った。

Function getIEMemSize() as Long
    On Error GoTo ErrorHandler

    Dim WMI As New WbemScripting.SWbemLocator
    Dim oService As Object, oClassSet As Object, oClass As Object
    Set oService = WMI.ConnectServer
    Set oClassSet = oService.ExecQuery("SELECT * FROM Win32_Process")

    Dim ieMemSize: ieMemSize = 0
    For Each oClass In oClassSet
        If oClass.caption = "iexplore.exe" Then
            ieMemSize = ieMemSize + oClass.WorkingSetSize
        End If
    Next

    Set oClass = Nothing
    Set oClassSet = Nothing
    Set oService = Nothing
    Set WMI = Nothing

    getIEMemSize = cLng(ieMemSize / 1024 / 1024)
    Exit Function
ErrorHandler:
    debugPrintFile "getIEMemSize error! Err.Number=[" & err.Number & "], Err.Description=[" & err.description & "]"
    getIEMemSize = -1
End Function

あとは、ブラウザ操作側でこの関数を呼び出して、一定の値を超えていればIEプロセスをkillすればよい。 以下のようなプロセスをkillする関数を作って、引数に “iexplore.exe” を渡すようにコールする。

Sub pkill(strProcName As String)
    On Error Resume Next

    Dim objProcList ' プロセス一覧
    Dim objProcess  ' プロセス情報
    Dim lngKillNum  ' 終了したプロセス数
    lngKillNum = 0

    Set objProcList = GetObject("winmgmts:").InstancesOf("win32_process")
    For Each objProcess In objProcList
        If LCase(objProcess.Name) = strProcName Then
            objProcess.Terminate
            If err.Number = 0 Then
                lngKillNum = lngKillNum + 1
            Else
                Debug.Print "エラー: " & err.description
            End If
        End If
    Next

    If lngKillNum > 0 Then
        Debug.Print strProcName & " を " & lngKillNum & " 個強制終了しました。"
    Else
        Debug.Print strProcName & " が見つかりませんでした。"
    End If
    Set objProcList = Nothing
End Sub

参考ページ

https://excel-ubara.com/excelvba4/EXCEL_VBA_438.html

関連ページ

前のページ
次のページ