削除

WinXP,7のIE8にて新規セッションで起動削除

Message#16 2014年12月26日(金)10時05分
From: 旅しぐれ

どうやらあと一歩のところまで来たようですね。

○IEの起動
　⇒ IEが起動して、HPが表示されたのであれば、その記述で
　　 OK です。そもそもの目的である『新規セッションで起動』
　　になっていたでしょうか？

○Call GetWindowThreadProcessIdのところでエラー
　⇒ 何が邪魔しているのかと思ったら、Outlookでしたか…。
　　コードに直してみたので、こちらで試してください。
------------------------------------------------------------
' 指定されたウィンドウを作成したスレッドの ID を取得するAPI関数
' http://msdn.microsoft.com/ja-jp/library/cc364779.aspx
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, ByRef ProcessId As Long) As Long

Public Sub ろぐいん()

' IE を起動
Dim IEProcessId As Long ' 起動した IE のプロセスID
IEProcessId = Shell("C:\Program Files\Internet Explorer\iexplore.exe -noframemerging http://")

' 起動した IE を探す
Dim IE As Object
Dim ShellObject As Object
Set ShellObject = CreateObject("Shell.Application")
Do While True
　　' ShellWindows のリストを取得し、その中から起動したIEを探す
　　For Each Explore In ShellObject.Windows()
　　　　' 取得した ShellWindows のリストからIE, Explorer を抽出(Outlookを排除)
　　　　If TypeName(Explore) = "IWebBrowser2" Then
　　　　　　' プロセスIDを取得
　　　　　　Dim CurrentProcessId As Long
　　　　　　Call GetWindowThreadProcessId(Explore.hwnd, CurrentProcessId)
　　　　　　' 起動した IE のプロセスIDと比較
　　　　　　If CurrentProcessId = IEProcessId Then
　　　　　　　　' 見つけた IE のオブジェクトを回収
　　　　　　　　Set IE = Explore
　　　　　　　　' IE が見つかったので、Whileループを抜ける
　　　　　　　　Exit Do
　　　　　　End If
　　　　End If
　　Next
　　
　　' ここに処理が来たときは、IEが見つからなかった
　　' (まだIEが起動中の場合は見つけることができない)
　　' 1秒待ってリトライする
　　Call Application.Wait(Now + TimeValue("00:00:01"))
Loop
Set ShellObject = Nothing

' ここから先は元のコードが使えます
' 文字入力
IE.document.getElementById("ID").Value = UserID
IE.document.getElementById("PASS").Value = UserPass
(以下省略)

上のメッセージを削除します。
よければパスワードを入力し、削除ボタンをクリックしてください。