| タイトル | ： 解決できませんでした |
| 記事No | ： 16119 |
| 投稿日 | ： 2015/04/11(Sat) 23:42 |
| 投稿者 | ： はなまるき |
> という状況だとしたら、URL1 側の IE の終了通知を拾えないのは自明ですね。
> OnQuit の通知を受け取る前に、以前のインスタンスを捨ててしまう事になりますから。
こちらです
> コントロール配列「のような」イベント管理コレクションを自作する、という話です。
クラス化してそれを配列にしましたが目的は達成できませんでした。
以下のコードにて
フォームモジュール
Private sub List1.Click()
'変数については多少省略しています
Dim strURL as string
Dim ExistURL as string
Dim ExistIE As Object
strURL=List1.Text
ExistURL=Text1.Text
If IECheck(strURL, ExistURL, ExistIE) Then
Call ShowWindow(ExistIE.hwnd, SW_MAXIMIZE)
Set ExistIE = Nothing
Else
Dim objIE As Object
Set objIE = OpenIE(strURL)
IEInputTextbox objIE, IDElement, LoginID
IEInputTextbox objIE, PasswordElement, Password
If CheckboxElement <> vbNullString Then
If ckReverse Then
IECheckBoxClick objIE, CheckboxElement, True
Else
IECheckBoxClick objIE, CheckboxElement, False
End If
End If
IEInputImageClick objIE, LogInElement, src
Do While objIE.Busy = True Or objIE.ReadyState <> 4
DoEvents
Loop
Call ShowWindow(objIE.hwnd, SW_MAXIMIZE)
Set objIE = Nothing
End If
End sub
標準モジュール
Public Function OpenIE(strURL As String) As Object
Dim objIE As Object
Set objIE = CreateObject("InternetExplorer.application")
With objIE
.Visible = True
Call CloseWindow(.hwnd)
.Navigate (strURL)
Do While .Busy = True Or .ReadyState <> 4
DoEvents
Loop
End With
Set OpenIE = objIE
End Function
Public Function IECheck(strURL As String, Optional ExistsURL As String, Optional ExistIE As Object) As Boolean
On Error GoTo Exit_Function
Dim objShell As Object
Dim objShellWindows As Object
Dim objIE As Object
Dim ret As Boolean
Set objShell = CreateObject("Shell.Application")
Set objShellWindows = objShell.Windows
For Each objIE In objShellWindows
Select Case ExistsURL
Case vbNullString
If InStr(objIE.LocationURL, strURL) <> 0 Then
ret = True
Set ExistIE = objIE
Call ShowWindow(objIE.hwnd, SW_MAXIMIZE)
GoTo Exit_Function
End If
Case Else
If InStr(objIE.LocationURL, ExistsURL) <> 0 Then
ret = True
Set ExistIE = objIE
GoTo Exit_Function
End If
End Select
Next
ret = False
Exit_Function:
IECheck = ret
Set objShell = Nothing
Set objShellWindows = Nothing
End Function
Public Sub IEInputTextbox(objIE As Object, strElement As String, Value As String)
On Error Resume Next
Dim objInput As Object
Dim str1 As String
For Each objInput In objIE.document.getElementsByTagName("Input")
If InStr(1, objInput.outerhtml, strElement, vbTextCompare) <> 0 Then
objInput.Value = Value
Exit For
End If
Next
End Sub
Public Sub IECheckBoxClick(objIE As Object, Name As String, Value As Boolean)
Dim objCK As Object
For Each objCK In objIE.document.getElementsByTagName("Input")
If InStr(objCK.outerhtml, Name) <> 0 Then
objCK.Checked = Value
End If
Next
End Sub
Public Function IEInputImageClick(objIE As Object, Element As String, Optional imageSrc As String)
Dim objInput As Object
For Each objInput In objIE.document.getElementsByTagName("Input")
Select Case imageSrc
Case vbNullString
If InStr(objInput.outerhtml, Element) <> 0 Then
objInput.Click
Exit For
End If
Case Else
If InStr(objInput.src, imageSrc) <> 0 And InStr(objInput.outerhtml, Element) Then
objInput.Click
Exit For
End If
End Select
Next
End Function
まず、OpenIEにてIEを起動後、同じサイトを起動しIECheckでチェックしてみました。
すると次のようなことが起こりました。
ローカルウィンドウでobjShellWindowsをチェックしてみたところ、
カウントが増える場合と増えない場合があることがわかりました。
それは同一サイトでおこります。
イメージとしては、
パターン１
①Yahooのさいとを開く→ objShellWindowsのcountが増える
②閉じずに再度Yahooのサイトを開く → 同じWindowが最前面に表示される
③閉じずに再度Yahooのサイトを開く → 同じWindowが最前面に表示される
パターン２
①Yahooのさいとを開く→ objShellWindowsのcountが増えない
②閉じずに再度Yahooのサイトを開く → 新しいYahooサイトのWindowが最前面に表示される
③閉じずに再度Yahooのサイトを開く → 新しいYahooサイトのWindowが最前面に表示される
どういう場合にこの違いが生まれるのかがわかりません。
ご教示よろしくお願いします。
|