VBAで任意の文字がURLに出現するまでIEを監視させる

郵便局のクリックポストを大量に出力するプログラムを作っています。

その中で決済画面に移行する際に、何秒か待つプログラムにしていましたが、
より安定的にするためにURLに任意の文字が出現するまでIEを監視するものに作っていますが
「loopに対応するDOがありません」となります。

どこを改善したらいいでしょうか？



Function targeturl(urlmozi As String) As InternetExplorer
Dim colsh As Object
Dim ie As InternetExplorer
Dim strTemp As String
Dim objIE As Object
Dim flag As Integer

'初期化
strTemp = ""

'フラッグを初期化
flag = 0

Do While flag = 1

'flagが０なら、IEの分析を繰り返す

Sleep 1

'今あるIEをすべて取得します。
Set colsh = CreateObject("shell.application")

'一つずつ分解
For Each ie In colsh.Windows
'分解したieのURLを取得する
strTemp = ie.document.Location

If InStr(strTemp, urlmozi) > 0 Then
flag = 1
Set targeturl = ie
End If
Exit For

　’10ミリ秒待って再チャレンジ
　Sleep 10
Loop



End Function

No.1 回答者： WindFaller 回答日時： 2016/08/27 16:54

ご質問のコードをざっと見ると

Sleep 1　もう少し長く取りましょう
Sleep 10　これでも短いですね。それで、取りこぼすことはないと思います。
それと一緒に、DoEvents も加えておいたほうが無難ですね。

flag = 1 は見つけたという意味ですね。
flag =0 で、Do While flag = 1 なら、Loop は、通らないはずです。

For Each ie In colsh.Windows　'ここは、objIE にするのでは？　IE はわかるけれども、Shell のWindows から取れるものは、生のIE ではないはずです。
別にエラーが出ないなら、こちらが言う筋合いではないと言われそうですが。

それに、終わりがありませんね。For Each ～　Next です。

IE 側は、事前バインディングしているのに、Shell 側はしないのでしょうか。
Set colsh = CreateObject("shell.application")

それと、
strTemp = ie.document.Location
Document にLocation プロパティはあったのでしょうか。

あまり、人様のコードをいじりまわすと、また、怒られてしまいますが、私の解釈です。ただ、見つからないと、無限ループになる恐れがありそうな気がします。もうひとつ、どこかで安全弁を作ったほうがよいと思います。

Function targeturl(urlmozi As String) As InternetExplorer
　Dim colsh As Object
　Dim ie As InternetExplorer　　'←この部分は浮いています。
　Dim strTemp As String
　Dim objIE As Object
　Dim flag As Integer

　strTemp = ""
　
　'フラッグを初期化
　flag = 0
　Do
　　'flagが０なら、IEの分析を繰り返す
　　Sleep 10
　　
　　'今あるIEをすべて取得します。
　　Set colsh = CreateObject("Shell.Application")
　　'一つずつ分解
　　For Each objIE In colsh.Windows
　　　'分解したieのURLを取得する
　　　　strTemp = objIE.LocationURL
　　　　If InStr(strTemp, urlmozi) > 0 Then
　　　　　flag = 1
　　　　　Set targeturl = objIE
　　　　　Exit For
　　　　End If
　　　'10ミリ秒待って再チャレンジ
　　　Sleep 10
　　　DoEvents
　　Next
　Loop Until flag = 1

End Function


そこで、私なりに、コードを考えてみました。ふつう、画面が変わっているなら、IE のイベントを取るのが普通です。

VBA内部のMsgBox ですと、あまり華々しくメッセージが出ませんでしたが、拾っていることは間違いないです。

このURLの番号を探すプログラムです。
http://oshiete.goo.ne.jp/qa/9396135.html


要：Microsoft Internet Controls
'ThisWorkbook モジュール
Private WithEvents objIE As InternetExplorer

Sub StartIE()
　　myURL = "https://oshiete.goo.ne.jp/”
　　Set objIE = Nothing
　　Set objIE = New InternetExplorer
　　
　　objIE.Navigate myURL
　　objIE.Visible = True
End Sub

Private Sub objIE_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
Dim FindTxt As String
FindTxt = "9396135"
　If InStr(1, pDisp.LocationName, FindTxt, 1) > 0 Then
　　 Application.EnableEvents = False
　　 Call Call GetIEObject(objIE)
　End If
End Sub


'標準モジュール
Sub GetIEObject(obj As InternetExplorer)
　 MsgBox obj.LocationURL
End Sub

もしも、勘違いしていましたら、ご寛容のほどを。