IE操作 ソース内のjavascriptを表示後、

質問

VBAでIE操作をしているのですが、
javascriptのURLを踏んだ後に、そのページをオブジェクトに格納して値の取得等をしたいのですが、
うまくいきません。

For Each myObj In objIE.document.all.tags("a")
If myObj.href Like "*affiliateUrl1*" Then
objIE.navigate myObj.href
' Call IE_wait
Exit For
End If
Next

上記のコードで、
javascript:show_rakuten_linkcd('linkUrl1','imageUrl_S1','imageUrl_M1','title1','price1','reviewCount1','affiliateUrl1');
を見つけて、objIE.navigate myObj.href
で、ページを表示することは出来たのですが、
Call IE_wait
で

Sub IE_wait()
Const READYSTATE_COMPLETE As Long = 4

Do Until objIE.readyState = READYSTATE_COMPLETE
Loop

Do While objIE.Busy = True
DoEvents
Loop
End Sub

をすると、無限ループに入ります。

javascriptでページを表示させても、
objIEに格納されているURLは、javascriptを踏む前の元のページだからと思います。

なので、表示されるまで待つのは手動でやるとしたのですが、
その後、

For Each myObj In objIE.document.all.tags("testarea")
If myObj.Name = "code" Then

　　’ソース取得

End If
Next

とやろうとしても、objIEに格納されているＵＲＬがjavascriptで表示させているページでない為、
取得できません。

objIE.navigate myObj.href
を実行した後に、javascriptのページ(小窓）を格納する方法があれば教えてください。
よろしくお願いします。

回答No.2

mitarashi · ベストアンサー

#1です。確かに連続で実行すると、二回に一回？CreateObjectのところで、オートメーションエラーになりますね。
ところで問題のページですが、電卓がポップアップします（他にもあるかもしれませんが、一番目についたので）。説明不足ですみません。これをコードでポップアップさせてみました。当方の環境ではポップアップロックを外す必要がありました。無名関数を使っているので、とりあえず泥臭い方法で特定して実行させてみました。変更したところだけ載せます。
Sub test()
Dim myElements As IHTMLElementCollection
Dim i As Long

Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate "http://www.724685.com/"
IE_wait ie
Set myElements = ie.document.getElementsByTagName("A")
For i = 0 To myElements.Length - 1
If Left(myElements(i).href, 10) = "javascript" And InStr(myElements(i).href, "http://www.724685.com/calc/") > 0 Then
myElements(i).Click
Exit For
End If
Next i
End Sub

下記の様にコードで終了させると、二回目のオートメーションエラーが出ない気もしますが、あまり検証できていません。ご参考まで。
Sub terminate()
ie2.Quit
Set ie2 = Nothing
ie.Quit
Set ie = Nothing
End Sub

お礼

再度ご回答ありがとうございます。

検証してみたところ、
ie2.のオブジェクトに電卓のＵＲＬが格納されてる事を確認できました！

Sub terminate()
ie2.Quit
Set ie2 = Nothing
ie.Quit
Set ie = Nothing
End Sub

これの追加で、オートメーションエラーの発生も防げました！

クラスについてよくわからないのでこれから勉強して、
今回ご回答いただいた方法と掛け合わせて
自分のやりたいことを完成させたいと思います。

大変参考になりました。
ありがとうございます。

回答No.1

mitarashi

ポップアップがあるページを探すのに苦労してしまいました。
下記で、ポップアップのURLが取得できましたが、NavigateComplete2が複数回発生するのか、6回Debug.Printされました。
この時NavigateComplete2で取得される引数のURLは、目的のURL、訳の分からないURL2個、about:blank3個でした。
ご参考まで。

イベントを補足するために、クラスモジュールで、WithEventsで宣言する必要があります。
クラスモジュールを用いるか、クラスモジュールであるThisworkbookモジュール、Sheetモジュールなど（標準モジュール以外）に記述する必要があります。ここではSheetモジュールでテストしました。環境はxl2010-32bit、IE10、Windows7-64bitです。

'Microsoft Internet Control
'Microsoft HTML Object Library
'に参照設定

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Public WithEvents ie As WebBrowser
Public WithEvents ie2 As WebBrowser

Sub test()
Set ie = CreateObject("InternetExplorer.Application")
ie.Visible = True
ie.navigate "http://www.724685.com/"
IE_wait ie
End Sub

Private Sub ie_NewWindow2(ppDisp As Object, Cancel As Boolean)
Set ie2 = New InternetExplorer
Set ppDisp = ie2
End Sub

Private Sub ie2_NavigateComplete2(ByVal pDisp As Object, URL As Variant)
Debug.Print ie2.LocationURL
End Sub

Sub IE_wait(objIE As WebBrowser)
Do Until objIE.readyState = READYSTATE_COMPLETE
Loop
Do While objIE.Busy = True
DoEvents
Loop
Sleep 500
End Sub

お礼

回答が付かないと思っていました、ついて嬉しいです！

テストできるＵＲＬを提示すればよかったですね。失礼しました。

クラスモジュールについてはよくわからないのです。すいません・・・
頂いたコード全てをシートモジュールに貼り付けていいんですよね？

コードをシートモジュールに張り付けてtestプロシージャーをを実行したら
いくつかの意味ディエイトウインドウにＵＲＬが取得されました！

もう一度やってみようと、testプロシージャーを実行したら
オートメーションエラーになってしましました・・・

ちなみにhttp://www.724685.com/
のページはどこでポップアップが表示されるのでしょうか？

再度ご回答いただければ嬉しいです。