EXCEL VBAでIEを操作したいのですが、うまくいかない

Question

EXCEL VBAでIEを操作したいのですが、うまくいかない

Anonymous

YAHOOファイナンスから過去の株価を取得するためにWEBクエリーを実行していると途中で「応答なし」で泊まってしまうことについて、下記質問をしました。

http://answers.microsoft.com/ja-jp/office/forum/office_2010-excel/web%e3%82%af%e3%82%a8%e3%83%aa%e3%83%bc%e5%ae%9f/791a72b6-3f95-4d18-

82a0-f6724d91a3f0

解決できる回答がなかなかつかないので、下記VBAでIEを直接操作しようと思いました。

シート2のA列にコード、B列に取得開始日、C列に取得終了日が入っています。

東証1部で1800強の銘柄があります。

下記VBAを実行してみました。

ところが件目のコードの画面が表示され、処理のあと、次のコードの画面が表示されたところで止まってしまいます。通信もしていないようです。

しかし、A2:のところにストップマークを入れて、ステップバイステップで実行してみると2件目3件目と最後まですすみます。(とりあえず5件のみでテストしました)

これはいったいどういうことでしょう。ステップバイステップで実行すると順調にすすむのに、連続で実行すると止まってしまうのです。

しかも不可思議なことに、Win7 機で実行すると連続で最後(5件目)まですすみます。

Win7機のEXCELは2010　32ビット、こちらはWin8.1 EXCELは2010 64ビットです。

なにがなんだかわからず、戸惑っているばかりです。

どこに原因があるのか、解決できる回答をぜひお願いいたします。

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

Sub TEST()

Dim IE As InternetExplorer

Dim OBJ1 As Object, OBJ2 As Object

Dim DOC As HTMLDocument

Dim SCODE As Integer

Dim I As Integer, J As Integer

Const URL0 As String = "[http://info.finance.yahoo.co.jp/history/?code]="

Set IE = CreateObject("InternetExplorer.Application")

IE.Visible = True

Open "KABUDATA.CSV" For Output As #1

'

A0: I = I + 1

If Sheet2.Range("A" + Format(I)).Value = "" Then Exit Sub 'GoTo A9:

SDATE = Sheet2.Range("B" + Format(I)).Value

YY1 = Format(Year(SDATE)): MM1 = Format(Month(SDATE)): DD1 = Format(Day(SDATE))' 開始日の年、月、日をセット

SDATE = Sheet2.Range("C" + Format(I)).Value

YY2 = Format(Year(SDATE)): MM2 = Format(Month(SDATE)): DD2 = Format(Day(SDATE))' 終了日の年、月、日をセット

SCODE = Sheet2.Range("A" + Format(I)).Value

URL1 = Format(SCODE) + ".T&sy=" + YY1 + "&sm=" + MM1 + "&sd=" + DD1 + "&ey=" + YY2 + "&em=" + MM2 + "&ed=" + DD2 + "&tm=d&="

'

IE.Navigate URL0 + URL1'　URLをセット

A1: If IE.Busy Then GoTo A1:

A2: If IE.ReadyState < READYSTATE_COMPLETE Then Sleep 100: GoTo A2:

'「ここにHTMLのデータをファイルに出力する命令を記述」

B1: J = 0

Set DOC = IE.Document

Set OBJ1 = DOC.getElementsByTagName("a")' "a"のタグを選択

B2: If OBJ1(J).innerText = "次へ" Then GoTo B3: '「次へ」の語句がついたオブジェクトをさがしてクリック

J = J + 1

If J >= OBJ1.Length Then GoTo A0 Else GoTo B2: ' '「次へ」の語句がついたオブジェクトがない場合次のコードへ

'

B3: OBJ1(J).Click ' 次のページを表示するためオブジェクトをクリック

GoTo A1:

ロックされた質問。この質問は、Microsoft サポートコミュニティから移行されました。役に立つかどうかに投票することはできますが、コメントの追加、質問への返信やフォローはできません。

0 件のコメント

質問作成者が受け入れた回答

5 件の追加の回答

Answer 1

回答ではありません。

IEのVBAやスクリプトによる操作は私も良くやりますが、結構不安定で、OSのバージョンが変わった時は動かなくなることがかなりあります。

例えば、IEがBusyである間はWaitしてBusy状態でなくなったら読み込み完了とみなして処理するわけですが、これではだめで、理屈抜きで一秒程度のWaitをかけたらなんとかなるみたいなことがしょっちゅうです。

オブジェクトの取り方などは、質問すればちゃんとした答えが得られる場合がおおいですし、書籍もありますが、この質問のように、OSとIEのバージョンによるタイミングの問題のような場合はご自分でなんとかするしかありません。

タイミングの問題かどうか判別するには、問題となる処理の直前にMSGBOXを入れて、強制的に止め、OKを入れて続行させて正常に動くようなら0.5秒とか１秒とかSleepさせればほぼ正常に動く可能性があります。

SleepさせるにはAPIを使用すると簡単です。

Private Declare Sub Sleep Lib "kernel32" _

(ByVal dwMilliseconds As Long)

Sub Test()

MsgBox "OKを押すと3秒後に次のMsgBoxがでる"

Sleep 3000

MsgBox "再開しました"

End Sub

参考まで。

Answer 2

追加です。

こんなことをやると、読み込んだソーステキストをHTMLオブジェクトとして扱えるようです。

なお、MSGBOXが延々と出てきますので、捕まえたいエレメントだけを抜き出すようにするか、CTRL+Breakで適当なところで止めてください。

Sub aaa()

Dim wHttp As Object, wURL1 As String, wSTr As String

Set wHttp = CreateObject("MSXML2.xmlhttp")

wURL1 = "http://info.finance.yahoo.co.jp/history/?code=9701.T&sy=2014&sm=7&sd=26&ey=2014&em=8&ed=25&tm=d&="

On Error Resume Next

wHttp.Open "GET", wURL1, False

wHttp.send

If Err.Number = 0 Then

If wHttp.Status <> 200 Then

MsgBox wHttp.Status

Else

wSTr = ""

wSTr = wHttp.responseText

bbb wSTr

End If

Else

MsgBox Err.Number

End If

On Error GoTo 0

End Sub

Sub bbb(ByVal pStr As String)

Dim wElm As Object

Set HTML = CreateObject("htmlfile")

HTML.Open

HTML.write pStr

HTML.Close

For Each wElm In HTML.body.all

MsgBox wElm.innertext

Answer 3

直接これが、ABC888 さんの役に立つかどうか定かでないのですが、ブラウザを使用しないと言う手もあります。

Sub aaa()

Dim wHttp As Object, wURL1 As String, wSTr As String

Set wHttp = CreateObject("MSXML2.xmlhttp")

wURL1 = "http://info.finance.yahoo.co.jp/history/?code=9701.T&sy=2014&sm=7&sd=26&ey=2014&em=8&ed=25&tm=d&="

On Error Resume Next

wHttp.Open "GET", wURL1, False

wHttp.send

If Err.Number = 0 Then

If wHttp.Status <> 200 Then

MsgBox wHttp.Status

Else

wSTr = ""

wSTr = wHttp.responseText

MsgBox wSTr

End If

Else

MsgBox Err.Number

End If

On Error GoTo 0

End Sub

これでターゲットのソースを丸ごと引っ張りだしてます。

出てきたものはテキストですから、これを解析して望みの情報を取り出すのはIEオブジェクトを使って取り出すのとは全く別で、テキストを解析するプログラムの形になります。

個人的にはこちらの方がブラウザでやるより安定しているとは思います。

IEを使うタイプはかなり環境に依存し、私の経験でもOSが変わったら動かなくなったとか、IEのバージョンが上がったらダメになったとか毎回経験してます。

こうやって、ソースを取り出し、直接IEに表示できる手があるのかどうかは存じません。ですからソースをIEで表示するにはこのソースを一時ファイルに吐き出して、そのファイルをNavigateしてしまうとか言うことになります。

参考まで。

Answer 4

前に申しあげたように、こういうのは経験と勘でなんとかするしかないんです。

アイデアとしては、Busy等の判別がOKになったら、読み込んだサイトのデータがキチンとは言っているかどうか確認するなどです。

例えば一番簡単なのは、タイトルがちゃんと取れるかとか、この場合企業名がはいっているはずですから、企業名がちゃんと読み取れるかなどのチェックを入れ、それが確認できなければ更にループを続けるなどです。

Answer 5

返信ありがとうございます。

途中にSleepを入れてみたのですが、やはり止まってしまいます。

IE.Navigate URL0 + URL1

A1: If IE.Busy Then GoTo A1:

Sleep 5000

A2: If IE.ReadyState < READYSTATE_COMPLETE Then Sleep 100: GoTo A2:

途中にMsgBoxを入れると続けて動きだすのですが、これでは常に操作し続けないといけません。

IE.Navigate URL0 + URL1

A1: If IE.Busy Then GoTo A1:

MsgBox "OK"

A2: If IE.ReadyState < READYSTATE_COMPLETE Then Sleep 100: GoTo A2:

MsgBoxの"OK"を自動的にクリックする命令などないでしょうね。

自動で最後まで動かしたいのですが、何かよい方法はありませんでしょうか。

よろしくお願いいたします。

次の方法で共有

EXCEL VBAでIEを操作したいのですが、うまくいかない

5 件の追加の回答