« Vistaで、IE.Navigate()する。IEオブジェクトを乗り継ぐ。(その3) | トップページ | 任意のフォルダを「お気に入りの整理」で開く。 »

2010年3月28日 (日)

Vistaで、IE.Navigate()する。IEオブジェクトを乗り継ぐ。(その4)

保護モード: 無効 -> 有効 の場合に対応するには、iexpore.exeを起こして乗り継ぎます。
複数タブ状態やタイミングエラーにも対応します。

Set wShell=CreateObject("WScript.Shell")
Path=wShell.RegRead("HKLM\Software\Microsoft\Windows\CurrentVersion\App Paths\iexplore.exe\")
Set Shell=CreateObject("Shell.Application")
Randomize
Do
  FullName=UCase(Mid(Path,1,1))
  For k=2 To Len(Path)
    If Fix(Rnd*2) Mod 2 Then
      FullName=FullName & UCase(Mid(Path,k,1))
    Else
      FullName=FullName & LCase(Mid(Path,k,1))
    End If
  Next
  For k = Shell.Windows().Count To 1 Step -1
    If Shell.Windows().Item(k - 1).FullName = FullName Then Exit For
  Next
Loop While k
wShell.Run """" & FullName & """ -nohome",0
Do
  For Each ie In Shell.Windows()
    If ie.Visible Then
    ElseIf ie.ReadyState Then
    ElseIf ie.FullName=FullName Then
      Exit Do
    End If
  Next
  WScript.Sleep 100
Loop
ie.Visible=True

Sub Navigate(URL)
hwnd=ie.HWND
LocationURL=ie.LocationURL
Set dic=CreateObject("Scripting.Dictionary")
For Each ix In Shell.Windows()
  If hwnd=ix.HWND Then dic.Add ix,Empty
Next
ie.Navigate URL
Do
  Call TryWaitForReady(ie,hwnd,dic)
Loop While Err.Number
End Sub

Sub TryWaitForReady(ie,hwnd,dic)
On Error Resume Next
Call WaitForReady(ie,hwnd,dic)
End Sub

Sub WaitForReady(ie,hwnd,dic)
Do
  For Each ix In Shell.Windows()
    If hwnd=ix.HWND And Not dic.Exists(ix) Then
      Set ie=ix
      Exit For
    End If
  Next
  If Not ie.Busy And ie.ReadyState=4 Then Exit Do
  WScript.Sleep 100
Loop
End Sub

Navigate URL1
MsgBox ie.LocationURL
Navigate URL2
MsgBox ie.LocationURL

« Vistaで、IE.Navigate()する。IEオブジェクトを乗り継ぐ。(その3) | トップページ | 任意のフォルダを「お気に入りの整理」で開く。 »