[三流君] −−>
[VBAで楽しく] −−>
[バックナンバー一覧]
三流君VBA:IE操作 .tags("TD") で TDタグを抜いて遊ぶ
関連項目:Webページから表を取り込むサンプル。(別の切り口で)
↑ラフな設計から製造まで[VBA IE操作 表の取り込みサンプル]を見て下さい。
↑の実行サンプルは[↑の小細工した実行サンプル]
(IE_GET_TABLE_0316.zip です。解凍して動かして確認してください)
リンク 分類:
[Document(文章)からデータを取得]
/ [Form入力処理]
/ [Linkリンク情報]
/ [Image画像情報]
/ [Frameフレーム処理]
サンプル:
[IEを使ったVBAのサンプル]
/ [小さなVBAでIE操作のコード]
メルマガ発行内容
やっと、下記、メルマガで発行した内容です。何かの参考となれば幸いです。
過去のメルマガ[IE操作系の記事一覧]もヨロシクです。
IE操作 .tags("TD") で TDタグを抜いて遊ぶ
こんにちは。
久しぶりにIEの質問に答えてみました。
いつものようにキレのない 三流解説だけど・・・
/*
* 1. 今回のキッカケ
*/
依頼内容
--------
>↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓
>
> 以下、ソースの一部です。
>
> <TD colspan="3" bgcolor="#000000"><IMG src="../../zen/images/line_b.gif" width=200 height=2></TD><TD></TD><TD colspan="3" bgcolor="#000000"><IMG
src="../../zen/images/line_b.gif" width=200 height=2></TD>
> <TD></TD>
> </TR>
> <TR>
> <TD nowrap><FONT size="-1">金額-1</FONT></TD>
> <TD></TD>
> <TD align="right" nowrap>\ 3,299</TD><TD></TD>
> <TD nowrap><FONT size="-1">金額-2</FONT></TD>
> <TD></TD>
> <TD align="right" nowrap>\ 1</TD>
> </TR>
> <TR>
> <TD colspan="3" bgcolor="#000000"><IMG src="../../zen/images/line_b.gif" width=200 height=2></TD><TD></TD><TD colspan="3" bgcolor="#000000"><IMG
src="../../zen/images/line_b.gif" width=200 height=2></TD>
>
>↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑
>
> 上記ソースの7行目の『\3,299』の部分をアクセスのテーブルへ書きこみたいです。------
/*
* 2.簡単な方針(仕様) と テスト環境作り
*/
テーブルから金額のデータを抜き出したい、
そんな感じですね。
もっとプログラマー的に書けって?
<TD nowrap><FONT size="-1">金額-1</FONT></TD>
を見つけて、
<TD align="right" nowrap>\ 3,299</TD><TD></TD>
を抜き出す。
まずは、テスト環境作りかなぁ。
テストのデータを作成します(テスト環境を作ります)
http://ken3-info.blog.ocn.ne.jp/test/2009/02/20090217_5ee0.html
↑blogに固定のデータだけど、表を作りました。
/*
* 3. TDタグを抜き取るテスト・・・ document.all.tags("TD")
*/
TD タグだけを抜くテストプログラムを作ります。
Dim objTD As Object 'テーブルオブジェクトの格納用
Set objTD = objIE.document.all.tags("TD") '.tags("TD")でTDタグを抜く
こんな感じで、.tags("TD") でTDのオブジェクトの集合が取れるので、
あとは、カウンターを使って
objTD(n).InnerHTML
や
objTD(n).InnerTEXT
など、配列的に扱い、添え字でアクセスしてます。
テスト結果
http://www.youtube.com/watch?v=um_6UvV-TR4
↑三流動画解説
↓テストで使った表
http://ken3-info.blog.ocn.ne.jp/test/2009/02/20090217_5ee0.html
Sub test_0217_TD()
'IE を 起動して TD タグを抜いてシートに書いてみた
Dim objIE As Object 'IEオブジェクト参照用
Set objIE = CreateObject("InternetExplorer.application") 'IEのオブジェクトを作る
objIE.Visible = True '見えるようにする(お約束)
'.Navigate で 指定した文字列のURLを開く
objIE.Navigate "http://ken3-info.blog.ocn.ne.jp/test/2009/02/20090217_5ee0.html"
'表示終了まで待つ .Busy(忙しい)間 と.ReadyState(ステータス)が4以外の時 ループ
Do While objIE.Busy = True
DoEvents '特に何もしないで.Busyの状態が変わるまで待つ
Loop
Do While objIE.ReadyState <> 4
DoEvents '特に何もしないで.ReadyStateの状態が4に変わるまで待つ
Loop
'.tags("TD") で TDタグを抜き出す
Dim objTD As Object 'テーブルオブジェクトの格納用
Set objTD = objIE.document.all.tags("TD") '.tags("TD")でTDタグを抜く
'テスト用に新規のブックを追加する
Workbooks.Add '新規ブックを追加
Sheets.Add 'シートを新規追加する
ActiveSheet.Name = "TDタグを抜くテスト" 'シートに名前を付ける
'TDデータをシートに貼り付ける
Range("A1") = "TDタグを取り出すテスト"
Range("A2") = "変数n" '見出しをつける
Range("B2") = ".InnerHTML" '見出しをつける
Range("C2") = ".InnerTEXT" '見出しをつける
Range("D2") = ".OuterHTML" '見出しをつける
'いろいろなループを作れるけど、カウンタ n でまわしてみる
Dim n As Integer
For n = 0 To objTD.Length - 1 'カウンタ0から.length - 1 までまわす。
Cells(n + 3, "A") = n 'n+3行目にセット
Cells(n + 3, "B") = "'" & Left(objTD(n).InnerHTML, 80) 'デバック用に左から80文字までセット
Cells(n + 3, "C") = "'" & Left(objTD(n).InnerTEXT, 80) 'デバックなのでシングルコーテーションを付け
Cells(n + 3, "D") = "'" & Left(objTD(n).OuterHTML, 80) '文字列扱いでセットする
Next n
'後始末(使った食器はキレイにしてから戸棚に戻そうね)
Set objTD = Nothing
'objIE.Quit '今回はコメントにして処理しない(残しておいた方がテスト時は楽です)
'Set objIE = Nothing
End Sub
|
/*
* 4. 金額-1 を 探し 隣のデータを抜き出してみた。
*/
さてと、TDタグの抜き出しテストができたので本番、
っていっても、あまり変わらないけど。。。
objTD(n).InnerTEXT = "金額-1"
を見つけて、n+2番目の中身を取り出します。
ポイントは、
Set objTD = objIE.document.all.tags("TD") '.tags("TD")でTDタグを抜く
で、TDタグを取り出して、
For n = 0 To objTD.Length - 1 'カウンタ0から.length - 1 までまわす。
で、ループをまわし、
If objTD(n).InnerTEXT = "金額-1" Then 'テキストの中身が金額-1かきく
で、項目の判断、
strKINGAKU = objTD(n + 2).InnerTEXT '隣の値をセットするここでは+2で、ほしい隣のデータを取り出してます。
↓実行結果・テスト結果の動画
http://www.youtube.com/watch?v=tsMU8ADoda8
↑三流動画解説・・・
Sub test_0217_TD_getKINGAKU()
'IE を 起動して TD タグを.allから抜いて
'テキストが金額-1の項目を探す、
'見つけたら、隣の値(ここでは+2番目)を取り出す
Dim objIE As Object 'IEオブジェクト参照用
Set objIE = CreateObject("InternetExplorer.application") 'IEのオブジェクトを作る
objIE.Visible = True '見えるようにする(お約束)
'.Navigate で 指定した文字列のURLを開く
objIE.Navigate "http://ken3-info.blog.ocn.ne.jp/test/2009/02/20090217_5ee0.html"
'表示終了まで待つ .Busy(忙しい)間 と.ReadyState(ステータス)が4以外の時 ループ
Do While objIE.Busy = True
DoEvents '特に何もしないで.Busyの状態が変わるまで待つ
Loop
Do While objIE.ReadyState <> 4
DoEvents '特に何もしないで.ReadyStateの状態が4に変わるまで待つ
Loop
'.tags("TD") で TDタグを抜き出す
Dim objTD As Object 'テーブルオブジェクトの格納用
Set objTD = objIE.document.all.tags("TD") '.tags("TD")でTDタグを抜く
'いろいろなループを作れるけど、カウンタ n でまわしてみる
Dim n As Integer
Dim strKINGAKU As String '金額の文字列保存用
strKINGAKU = "noDATA" '文字列noDATAで初期化
For n = 0 To objTD.Length - 1 'カウンタ0から.length - 1 までまわす。
If objTD(n).InnerTEXT = "金額-1" Then 'テキストの中身が金額-1かきく
strKINGAKU = objTD(n + 2).InnerTEXT '隣の値をセットするここでは+2
Exit For '見つけたので、次は探さない・・から exitでループを抜ける
End If
Next n
If strKINGAKU = "noDATA" Then
'見つからなかった時は、エラー処理が必要なのでは???
Debug.Print "データ項目が見つかりませんでした。"
Else
'見つかったので、テストで、Debug.Print する
Debug.Print strKINGAKU
Debug.Print "金額は" & CLng(strKINGAKU) & "です" 'テストでCLngで変換してみた。。。
'あとは、Replace関数などで、カンマや¥を取り除いて使い易くすればいいのかなぁ、、、
strKINGAKU = Replace(strKINGAKU, ",", "")
strKINGAKU = Replace(strKINGAKU, "\", "")
strKINGAKU = Replace(strKINGAKU, " ", "") 'あっ cint(" \3,222")など変換系を使ってもOKですね。
Debug.Print "補正後 " & strKINGAKU
End If
'後始末(使った食器はキレイにしてから戸棚に戻そうね)
Set objTD = Nothing
'objIE.Quit '今回はコメントにして処理しない(残しておいた方がテスト時は楽です)
'Set objIE = Nothing
End Sub
|
/*
* 5.株価の金額を抜くには???
*/
あとは、応用なので、蛇足の解説する必要が無いのですが、
調子に乗って、三流解説を続けます。
よくある質問で 株式系 のデータを抜く 質問があります。
なので、指定した銘柄の 金額を抜いてみたいと思います。
Yahooファイナンスで
【6723】NECエレクトロニクス(株)
を探すと
http://stocks.finance.yahoo.co.jp/stocks/detail/?code=6723
↑上記のように、URLに銘柄コード6723を指定すればOKみたいです。
ここから、現在値 を抜くには(抜いてみたいと思います。)
まずは、テストでYahooファイナンスのページを開き
タグの TD を抜いてみます。※って、URL変わっただけで、ほとんど同じだけど。。。
'銘柄コードを入力後、
'IE を 起動して Yahooファイナンスのページを表示する
'その後 TD タグを.tagsで抜いてシートに書き込む Windows XP IE7 Excel2003 で テスト
Sub test_0222_TD()
'銘柄コードの入力
Dim strCODE As String '銘柄コード受け取り用
strCODE = InputBox("銘柄コード", "コード入力", "6723") '手抜きでInputBox関数を使用
'IEを起動して、Yahooファイナンスのページを表示する
Dim objIE As Object 'IEオブジェクト参照用
Set objIE = CreateObject("InternetExplorer.application") 'IEのオブジェクトを作る
objIE.Visible = True '見えるようにする(お約束)
'.Navigate で 指定した文字列のURLを開く
objIE.Navigate "http://stocks.finance.yahoo.co.jp/stocks/detail/?code=" & strCODE
'表示終了まで待つ .Busy(忙しい)間 と.ReadyState(ステータス)が4以外の時 ループ
Do While objIE.Busy = True
DoEvents '特に何もしないで.Busyの状態が変わるまで待つ
Loop
Do While objIE.ReadyState <> 4
DoEvents '特に何もしないで.ReadyStateの状態が4に変わるまで待つ
Loop
'TDデータをシートに書き出す
'.tags("TD") で TDタグを抜き出す
Dim objTD As Object 'テーブルオブジェクトの格納用
Set objTD = objIE.document.all.tags("TD") '.tags("TD")でTDタグを抜く
'テスト用に新規のブックを追加する
Workbooks.Add '新規ブックを追加
Sheets.Add 'シートを新規追加する
ActiveSheet.Name = "TDタグを抜くテスト" 'シートに名前を付ける
'TDデータをシートに貼り付ける
Range("A1") = "TDタグを取り出すテスト"
Range("B1") = objIE.document.URL 'URL情報をB1に書く
Range("C1") = objIE.document.Title 'タイトル情報をC1に書く
Range("A2") = "変数n" '見出しをつける
Range("B2") = ".InnerHTML" '見出しをつける
Range("C2") = ".InnerTEXT" '見出しをつける
Range("D2") = ".OuterHTML" '見出しをつける
'いろいろなループを作れるけど、カウンタ n でまわしてみる
Dim n As Integer
For n = 0 To objTD.Length - 1 'カウンタ0から.length - 1 までまわす。
Cells(n + 3, "A") = n 'n+3行目にセット
Cells(n + 3, "B") = "'" & Left(objTD(n).InnerHTML, 255) 'デバック用に左から255文字までセット
Cells(n + 3, "C") = "'" & Left(objTD(n).InnerTEXT, 255) 'デバックなのでシングルコーテーションを付け
Cells(n + 3, "D") = "'" & Left(objTD(n).OuterHTML, 255) '文字列扱いでセットする
Next n
'列幅を少し大きくする
Columns("B:D").ColumnWidth = 24
'終了処理
'後始末(使った食器はキレイにしてから戸棚に戻そうね)
Set objTD = Nothing
'objIE.Quit '今回はコメントにして処理しない(残しておいた方がテスト時は楽です)
'Set objIE = Nothing
MsgBox "終了しました"
End Sub
|
↓実行結果の動画
http://www.youtube.com/watch?v=2GlsoZtJddg
↑三流解説 [え〜と] And [こんな感じ] の音声付き(笑)
↑プログラムのポイントは特に無く(おぃおぃ)、
document.all.tags("TD")で抜き出したTDのデータ/テスト結果を見ると、
変数n .InnerHTML .InnerTEXT
0 "現在値<STRONG>(02/20)</STRONG>
<DIV class=btnDelay title=20分ディレイ株価>20分ディレイ株価</DIV>" 現在値(02/20) 20分ディレイ株価
1 <SPAN class=yjFL>477</SPAN> <SPAN class=yjL></SPAN> 477
2 <SPAN class=icoDownRed>前日比</SPAN><BR><STRONG class=redFin>-17</STRONG>(<STRONG class=redFin>-3.44</STRONG>%) "前日比
-17(-3.44%)"
となりました。
次は、ここ(現在値)から 一つ下、次のTDが値と決めて抜き出してみます。
'銘柄コードを入力後、
'IE を 起動して Yahooファイナンスのページを表示する
'document.all.tags("TD")でTDタグを抜き出す
'左から3文字が[現在値]のデータを探す
'見つかったら、その次のTDデータを金額・株価とする Windows XP IE7 Excel2003 で テスト
Sub test_0222_TD_KINGAKU()
'銘柄コードの入力
Dim strCODE As String '銘柄コード受け取り用
strCODE = InputBox("銘柄コード", "コード入力", "6723") '手抜きでInputBox関数を使用
'IEを起動して、Yahooファイナンスのページを表示する
Dim strTITLE As String 'Webページのタイトル保存用
Dim objIE As Object 'IEオブジェクト参照用
Set objIE = CreateObject("InternetExplorer.application") 'IEのオブジェクトを作る
objIE.Visible = True '見えるようにする(お約束)
'.Navigate で 指定した文字列のURLを開く
objIE.Navigate "http://stocks.finance.yahoo.co.jp/stocks/detail/?code=" & strCODE
'表示終了まで待つ .Busy(忙しい)間 と.ReadyState(ステータス)が4以外の時 ループ
Do While objIE.Busy = True
DoEvents '特に何もしないで.Busyの状態が変わるまで待つ
Loop
Do While objIE.ReadyState <> 4
DoEvents '特に何もしないで.ReadyStateの状態が4に変わるまで待つ
Loop
strTITLE = objIE.document.Title 'ドキュメントのタイトルを保存する
'document.all.tags("TD")でTDタグを抜き出す
Dim objTD As Object 'テーブルオブジェクトの格納用
Set objTD = objIE.document.all.tags("TD") '.tags("TD")でTDタグを抜く
'左から3文字が[現在値]のデータを探す
Dim n As Integer 'ループのカウンタ
Dim lngKABUKA As Long '株価(現在値)
lngKABUKA = -1 'ありえない価格 −1を入れる※あとでエラーチェックで使う
For n = 0 To objTD.Length - 1 'カウンタ0から.length - 1 までまわす。
If Left(objTD(n).InnerTEXT, 3) = "現在値" Then '左から3文字をチェックする
lngKABUKA = CLng(objTD(n + 1).InnerTEXT) 'n+1番目を変換し 株価・現在値
End If
Next n
'終了処理
'後始末(使った食器はキレイにしてから戸棚に戻そうね)
Set objTD = Nothing
objIE.Quit '今回は.QUITで使ったIEを閉じてみた。
Set objIE = Nothing
'結果表示
If lngKABUKA = -1 Then '金額が−1の時は見つからないのでエラー
MsgBox strCODE & "は 見つかりませんでした。"
Else
'見つかった時は結果を表示する
MsgBox strCODE & " の現在値は[ " & lngKABUKA & " ]です。" & vbCrLf & strTITLE
End If
End Sub
|
↓実行結果の動画
http://www.youtube.com/watch?v=MVsh1XnfYOw
↑三流解説 [え〜と] And [こんな感じ] の音声付き(笑)
無事に現在の値が取れたと思います。
えっ、コレだけじゃ使えないだろって?
まぁ、そんなこと言わないでよ・・・
/*
* 6.複数の金額を抜くには???
*/
う〜ん、今日はもう遅いから最後だよ、
A列 の10行目から複数銘柄コードを書いて、値を貼り付けていく、
そんなサンプルを作ってみます。
↓実行結果の動画
http://www.youtube.com/watch?v=ldZi5AFZuNw
↑を見ながら、下記のサンプルを見てください。
A列にコード B列に値
6723
6502
・
・
6753
と、調査したい銘柄コードをA列10行目から記入して、
A列の中身が空白になるまで値を連続で取り出し、隣のB列にセットしてみます。
パターン的な
初期処理
処理
後始末
そんな感じを日本語で書くと、
Sub test_0222_KABUKA_GET()
'初期処理 まず、外側でIEを起動する
Dim strTITLE As String 'Webページのタイトル保存用
Dim objIE As Object 'IEオブジェクト参照用
Set objIE = CreateObject("InternetExplorer.application") 'IEのオブジェクトを作る
objIE.Visible = True '見えるようにする(お約束)
'A列の銘柄がなくなるまで、10行目からループ
'銘柄コードを1つ取り出す
'Yahooファイナンスのページを表示させる
'表示が完了するまで待つ
'現在値・株価を取り出す※探す
'B列にセット
'終了処理
objIE.Quit '今回は.QUITで使ったIEを閉じてみた。
Set objIE = Nothing
End Sub
|
↑まぁ、コメントの箇条書きだとこんなに短いんだけどなぁ。
なんてくだらないこと言ってないで、
10行目からループなので、
strCODE = Cells(y, "A") で取り出し、
If Len(strCODE) = 0 Then で判断
Exit For で抜ける、そんな処理を書いてみました。
Sub test_0222_KABUKA_GET()
'初期処理 まず、外側でIEを起動する
Dim strTITLE As String 'Webページのタイトル保存用
Dim objIE As Object 'IEオブジェクト参照用
Set objIE = CreateObject("InternetExplorer.application") 'IEのオブジェクトを作る
objIE.Visible = True '見えるようにする(お約束)
'A列の銘柄がなくなるまで、10行目からループ
Dim y As Integer 'Y行カウンタ
Dim strCODE As String 'コード保存用
For y = 10 To 9999 '10行目から9999行目までのループを作る
strCODE = Cells(y, "A") '銘柄コードを1つ取り出す
Debug.Print strCODE
If Len(strCODE) = 0 Then '文字数が0なら空白とみなしループを抜ける
Exit For 'forのy行 ループを抜ける
End If
'Yahooファイナンスのページを表示させる
'表示が完了するまで待つ
'現在値・株価を取り出す※探す
'B列にセット
Next y
'終了処理
objIE.Quit '今回は.QUITで使ったIEを閉じてみた。
Set objIE = Nothing
End Sub
|
まぁ、上↑で銘柄コードのループができたので、次は
'Yahooファイナンスのページを表示させる
'表示が完了するまで待つ
の2つを組み入れます。
ページの表示は、
objIE.Navigate "http://stocks.finance.yahoo.co.jp/stocks/detail/?code=" & strCODE
と、取り出した銘柄コードを付加してページを開き、
表示待ちは いつもの objIE.Busy と objIE.ReadyState を 見て判断。
Sub test_0222_KABUKA_GET()
'初期処理 まず、外側でIEを起動する
Dim strTITLE As String 'Webページのタイトル保存用
Dim objIE As Object 'IEオブジェクト参照用
Set objIE = CreateObject("InternetExplorer.application") 'IEのオブジェクトを作る
objIE.Visible = True '見えるようにする(お約束)
'A列の銘柄がなくなるまで、10行目からループ
Dim y As Integer 'Y行カウンタ
Dim strCODE As String 'コード保存用
For y = 10 To 9999 '10行目から9999行目までのループを作る
strCODE = Cells(y, "A") '銘柄コードを1つ取り出す
Debug.Print strCODE
If Len(strCODE) = 0 Then '文字数が0なら空白とみなしループを抜ける
Exit For 'forのy行 ループを抜ける
End If
'Yahooファイナンスのページを表示させる
'.Navigate で strCODEを付加した文字列のURLを開く
objIE.Navigate "http://stocks.finance.yahoo.co.jp/stocks/detail/?code=" & strCODE
'表示が完了するまで待つ
'表示終了まで待つ .Busy(忙しい)間 と.ReadyState(ステータス)が4以外の時 ループ
Do While objIE.Busy = True
DoEvents '特に何もしないで.Busyの状態が変わるまで待つ
Loop
Do While objIE.ReadyState <> 4
DoEvents '特に何もしないで.ReadyStateの状態が4に変わるまで待つ
Loop
strTITLE = objIE.document.Title 'ドキュメントのタイトルを保存する
Cells(y, "C") = strTITLE 'C列に Webページのタイトルをセットする
'現在値・株価を取り出す※探す
'B列にセット
Next y
'終了処理
objIE.Quit '今回は.QUITで使ったIEを閉じてみた。
Set objIE = Nothing
End Sub
|
↑やっと、それらしくなってきましたね。
最後に TD タグから 現在値を探し(次のTDタグの値をセット)
を組み入れれば完了かなぁ。
TDタグの抜き出しは
Set objTD = objIE.document.all.tags("TD") '.tags("TD")でTDタグを抜く
でまとめてから、
左から3文字が[現在値]のデータを探したいので、
For n = 0 To objTD.Length - 1 'カウンタ0から.length - 1 までまわす。
ループを作ったら、
If Left(objTD(n).InnerTEXT, 3) = "現在値" Then '左から3文字をチェックする
で判断して、
lngKABUKA = CLng(objTD(n + 1).InnerTEXT) 'n+1番目を変換し 株価・現在値
+1※隣の値をClngで変換し代入↑ます。
Exit For '探し終わったので、TDのループを抜けます
End If
Next n
これを組み入れて、少し長くなりましたが↓
Sub test_0222_KABUKA_GET()
'初期処理 まず、外側でIEを起動する
Dim strTITLE As String 'Webページのタイトル保存用
Dim objIE As Object 'IEオブジェクト参照用
Set objIE = CreateObject("InternetExplorer.application") 'IEのオブジェクトを作る
objIE.Visible = True '見えるようにする(お約束)
'A列の銘柄がなくなるまで、10行目からループ
Dim y As Integer 'Y行カウンタ
Dim strCODE As String 'コード保存用
Dim objTD As Object 'テーブルオブジェクトの格納用
Dim n As Integer 'TDのループで使うカウンタ
Dim lngKABUKA As Long '株価(現在値)一時保存用
For y = 10 To 9999 '10行目から9999行目までのループを作る
strCODE = Cells(y, "A") '銘柄コードを1つ取り出す
Debug.Print strCODE
If Len(strCODE) = 0 Then '文字数が0なら空白とみなしループを抜ける
Exit For 'forのy行 ループを抜ける
End If
'Yahooファイナンスのページを表示させる
'.Navigate で strCODEを付加した文字列のURLを開く
objIE.Navigate "http://stocks.finance.yahoo.co.jp/stocks/detail/?code=" & strCODE
'表示が完了するまで待つ
'表示終了まで待つ .Busy(忙しい)間 と.ReadyState(ステータス)が4以外の時 ループ
Do While objIE.Busy = True
DoEvents '特に何もしないで.Busyの状態が変わるまで待つ
Loop
Do While objIE.ReadyState <> 4
DoEvents '特に何もしないで.ReadyStateの状態が4に変わるまで待つ
Loop
strTITLE = objIE.document.Title 'ドキュメントのタイトルを保存する
Cells(y, "C") = strTITLE 'C列に Webページのタイトルをセットする
'現在値・株価を取り出す※探す
Set objTD = objIE.document.all.tags("TD") '.tags("TD")でTDタグを抜く
'左から3文字が[現在値]のデータを探す 文字現在値の隣の値を抜き出す・・
lngKABUKA = -1 'ありえない価格 −1を入れる※あとでエラーチェックで使う
For n = 0 To objTD.Length - 1 'カウンタ0から.length - 1 までまわす。
If Left(objTD(n).InnerTEXT, 3) = "現在値" Then '左から3文字をチェックする
lngKABUKA = CLng(objTD(n + 1).InnerTEXT) 'n+1番目を変換し 株価・現在値
Exit For '探し終わったので、TDのループを抜けます
End If
Next n
'後始末(使った食器はキレイにしてから戸棚に戻そうね)
Set objTD = Nothing
'B列にセット
If lngKABUKA = -1 Then '見つからなかったエラーのチェック
Cells(y, "B") = "エラー 値の検索に失敗しました。"
Else
Cells(y, "B") = lngKABUKA 'B列に取り出した値をセットする。
End If
Next y
'終了処理
objIE.Quit '今回は.QUITで使ったIEを閉じてみた。
Set objIE = Nothing
End Sub
|
で、やっと完成かなぁ。
↓実行結果の動画
http://www.youtube.com/watch?v=ldZi5AFZuNw
↑三流解説 [え〜と] And [こんな感じ] の音声付き(笑)
/*
* 7.終わりの挨拶
*/
今回は、
Set objTD = objIE.document.all.tags("TD") '.tags("TD")でTDタグを抜く
を書いてみました。
サンプルファイル(Excel2003 Windows XP IE7でテスト)
http://www.ken3.org/vba/lzh/IE0217.zip
zipを解答解凍して中のIE0217.xlsを実行しながら確認してみてください。
プログラム作りは
^^^^^^^^^^^^^^^^
う〜ん・・・
まぁ、人それぞれ、十人十色、百社百色だけどね。
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
今回も逃げるように失礼します。
おい、待てよ。
えっ、何か?
[何か]じゃねぇだろ、何かじゃ・・・
OS:VistaのIE7 と Excel2007 で サンプル動かないよ・・・
あらら、テスト環境が一昔前の XP + Excel2003 だった。。。
複数環境で動くように記述しないと また怒られるよ。
もうすぐIE8もリリースされるってのに・・・まったく使えないな三流君は。。。
AB型の変わり者、三流プログラマーのKen3でした。
ページフッター リンクや広告、質問送信など
三流解説を読んでいただき、どうもです。ここから下は、三流君宛のメッセージ送信や 三流君のホームページの紹介・案内です
目的の情報が見つかったか?少々心配しつつ、、、※質問や感想は、気軽に送ってくださいね。
質問や要望など メッセージを送る(三流君に連絡する)
三流プログラマーのKen3 が 皆さんの質問にお答えします
と カッコつけて言っても、実力不足ですべての質問に回答することはできないのが現実なのですが、できる範囲で 三流的な逃げ手 や 解決方法 を探します(回答します)。
感想や質問・要望・苦情など 三流君へメッセージを送る。
時間的余裕のある要望・質問・苦情の場合は、下記のフォームからメッセージを送ることができます。
急ぎで連絡がほしい、そんな時は:[三流君連絡先]に連絡してください。
[トップページへ 戻る]
/ [VBA TOP]
/ [WebBrowser IEの操作 TOPへ]