IEのゴースト現象について、
自分の経験を基に不明なデバッグを減らすIEの閉じ方を
需要ありそうなので記載しておきます。
IE起動→スクレイピング→IE閉じる
の繰返しでたまにIE起動時でNGになることがあります。
原因は
閉じた後も裏でIEのプロセスが暫く残る事があるということが判明(・・;)
※他の何かが原因のケースがあるかもですが、自分の経験として。
そして対応方法として
IE.Quitの前にプロセスIDを取得しておき、
Quit後にプロセスを直に殺して対応しました。
WinAPIが多くなるのが難点です(^_^;)
使う【WinAPI】はこんな感じです～
GetWindowThreadProcessId
ウィンドウハンドル(IE.hWnd)からプロセスIDを取得
IsWindow
ウィンドウが生きてるか判定 ※IEが閉じるまで念の為に待つ用
OpenProcess
プロセスIDからプロセスのハンドルを取得
TerminateProcess
プロセスを殺す
※他にもっと簡単に解決できる方法があるかもなので、あくまで１つのケースとして
-------------------＜以下、VBAソース＞----------------------------------------------------------
Option Explicit
Option Private Module
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As LongPtr, lpdwProcessId As Long) As Long
Private Declare PtrSafe Function IsWindow Lib "user32" (ByVal hWnd As LongPtr) As Long
Private Declare PtrSafe Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As E_WinAPI_dwDesiredAccess_DesiredAccess, ByVal bInheritHandle As Long, ByVal dwProcessID As Long) As LongPtr
Private Enum E_WinAPI_dwDesiredAccess_DesiredAccess
' STANDARD_RIGHTS_REQUIRED = &HF0000 'アクセスフラグ、あるいは次のフラグの 1 つまたは複数を指定できる。
' PROCESS_ALL_ACCESS = &H1F0FFF '利用可能な範囲で､プロセスオブジェクトに対するすべてのアクセス権を指定する｡
' PROCESS_CREATE_PROCESS = &H80 '内部で使う｡
' PROCESS_CREATE_THREAD = &H2 'プロセス内にスレッドを作成するために､CreateRemoteThread 関数がこのプロセスのハンドルを使うことを認める｡
' PROCESS_DUP_HANDLE = &H40 'ハンドルを複製するために､DuplicateHandle 関数が複製元または複製先としてこのプロセスのハンドルを使うことを認める｡
PROCESS_QUERY_INFORMATION = &H400 'プロセスオブジェクトから情報を読み取るために、GetExitCodeProcess 関数と GetPriorityClass関数がこのプロセスのハンドルを使うことを認める｡
' PROCESS_SET_QUOTA = &H100 'メモリの上限（クォータ）を設定するために、AssignProcessToJobObject 関数と SetProcessWorkingSetSize 関数がこのプロセスのハンドルを使うことを認める｡
' PROCESS_SET_INFORMATION = &H200 'このプロセスの優先順位クラスを設定するために､SetPriorityClass 関数がこのプロセスのハンドルを使うことを認める｡
' PROCESS_TERMINATE = &H1 'このプロセスを終了するために､TerminateProcess 関数がこのプロセスのハンドルを使うことを認める｡
' PROCESS_VM_OPERATION = &H8 'このプロセスの仮想メモリを変更するために､VirtualProtectEx 関数､または WriteProcessMemory 関数がこのプロセスのハンドルを使うことを認める｡
PROCESS_VM_READ = &H10 'このプロセスの仮想メモリの内容を読み取るために､ReadProcessMemory 関数がこのプロセスのハンドルを使うことを認める｡
' PROCESS_VM_WRITE = &H20 'このプロセスの仮想メモリへの書き込みを行うために､WriteProcessMemory 関数がこのプロセスのハンドルを使うことを認める｡
' Synchronize = &H100000 'Windows NT/2000：このプロセスが終了するのを待つために、wait functions（待機関数）がこのプロセスのハンドルを使うことを認める｡
End Enum
Private Declare PtrSafe Function TerminateProcess Lib "kernel32" (ByVal hProcess As LongPtr, ByVal uExitCode As Long) As Long
Private Function prTest()
Dim IE As InternetExplorer
'※Explorer等,他の何かが取得されるケースがあるのでGetObjectは使わない
' Set IE = GetObject("", "InternetExplorer.Application")
' If IE Is Nothing Then Exit Function
'表示されてるIEを全て取得
Dim Dic As Scripting.Dictionary
Set Dic = fIE_Dic
If Dic.Count = 0 Then Exit Function
'全てのIEを閉じる
Dim Key As Variant
For Each Key In Dic.Keys
Set IE = Dic.Item(Key)
Call fIE_Quit_Sample(IE)
Next
End Function
Private Function fIE_Quit_Sample(IE As InternetExplorer)
'ウィンドウハンドル、プロセスIDを取得しておく
Dim hWnd As LongPtr
Dim PID As Long
On Error Resume Next
hWnd = IE.hWnd
Call GetWindowThreadProcessId(hWnd, PID)
On Error GoTo 0
If hWnd = 0 Then Exit Function
'IEのQuitで予期せぬエラーが発生するのを防止
On Error Resume Next
IE.Quit
On Error GoTo 0
'IEのウィンドウがQuitで閉じるまで念の為に待つ
Dim i As Long
For i = 1 To 1000 '※適宜調整
If IsWindow(hWnd) = 0 Then Exit For
Call Sleep(100) '※適宜調整
DoEvents '※適宜調整
Next
'プロセスハンドルを取得
Dim hProcess As LongPtr
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, False, PID)
If hProcess = 0 Then Exit Function
'プロセス終了
Call TerminateProcess(hProcess, 0)
'解放しておく
Set IE = Nothing
End Function
Private Function fIE_Dic(Optional Visible As Boolean = True) As Scripting.Dictionary
Dim Dic As Scripting.Dictionary
Set Dic = New Scripting.Dictionary
'下記でも同じだが、ShellWindowsで
' Dim sh As Shell32.Shell
' Set sh = New Shell32.Shell
' For Each sh.Windows
'IE,Explorer系のコレクションオブジェクトを生成
'※生成時にコレクション済
Dim Shell As ShellWindows
Set Shell = New ShellWindows
'※権限の異なるIE等が起動されていると、ForEachだとデバッグ発生となるのでForIで対応
Dim i As Long
For i = 1 To Shell.Count
On Error Resume Next
Dim Win As WebBrowser
Set Win = Nothing
Set Win = Shell.Item(i)
On Error GoTo 0
With Win
If fIE_IsIE(Win) = True Then
If .Visible = Visible Then
Set Dic.Item(CStr(.hWnd)) = Win 'LongPtr対策でCStr
End If
End If
End With
Next
Set fIE_Dic = Dic
End Function
Private Function fIE_IsIE(WebBrowser As WebBrowser) As Boolean
With WebBrowser
Dim Name As String
On Error Resume Next
Name = Replace(.FullName, .Path, "")
On Error GoTo 0
fIE_IsIE = (LCase(Name) = LCase("iexplore.exe"))
End With
End Function