[三流君] −−> [VBAで楽しく] −−> [バックナンバー一覧]

三流君VBA:IE操作 .tags("TD") で TDタグを抜いて遊ぶ

概要:
テーブルから項目を抜きたかったので、
'.tags("TD")でTDタグを抜く
Set objTD = objIE.document.all.tags("TD")
でTDの集合を抜き出し、
nを使ったループで現在値の文字を探し、データを取り出しました。


※メルマガ記事ではオブジェクトの参照設定をしていませんができれば、下記を参考に参照設定してください。
[Microsoft Internet Controls,Microsoft HTML Object Library を参照設定する](このほうが開発時、操作時に楽)
また、VistaとIE7の場合は、 [IE7 操作 Vistaで失敗]も参考にしてください。

関連項目: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でした。

ページフッター リンクや広告、質問送信など

三流解説を読んでいただき、どうもです。ここから下は、三流君宛のメッセージ送信や 三流君のホームページの紹介・案内です
目的の情報が見つかったか?少々心配しつつ、、、※質問や感想は、気軽に送ってくださいね。

[三流君 VBAでWebBrowser IEを操作する] / [三流君 VBAで楽しくプログラミング] / [AB型の変わり者 三流プログラマー Ken3 三流君Top]

大分類:[Document.Forms(入力処理)] / [Document.Links(リンク情報)] / [Document.Images(画像情報)] / [Document.Frames(フレーム処理)]
サンプル・例題:[過去のメルマガ記事一覧] / [少し大きなIE操作サンプル] / [小さなコードでIE操作の動作確認]

F1でヘルプを見たり、デバック時にDebug.Print使ったり、イミディエイト ウインドウで簡単な確認したり。
なれると当たり前に操作している方法が↓かなぁ。
[F1ヘルプ マクロ記録ほか]・・・基本のF1を押してヘルプを見る方法など
[実行時エラー、デバッグモード]・・・デバッグの流れを簡単に(ハマった時はツライけど)
[イミディエイト ウインドウ と Debug.Print]・・・プログラム作成時に便利なイミディエイト ウインドウ
[VBA ウォッチ式とSTOPを使ってみた]・・・STOPで止め、ウォッチ式でオブジェクトの中身を確認する方法など
[参照設定のお話]・・・設定すると便利な(設定しないと使えない)、参照設定のお話

項目別に↓にプログラマーの本音?それとも建て前?的な記事をまとめました。お探しのジャンルを選択してください。
[プログラムは心? spirit]・・・プログラマー 心・気質・魂
[学ぶ study]・・・学習、技術の取得
[仕様書 doc]・・・仕様書・設計書関係の話

項目別に↓に人気の記事をまとめてみました。お探しのジャンルを選択してください。
[VBAでIE ウェブブラウザーを操作]・・・VBAでIE,WebBrowserを操作する サンプルです
[MSアクセス から エクセル を呼ぶ Excel.Application]・・・AccessからExcelを操作したりデータの書き出しなどです
[アウトルック メールの操作 Outlook.Application]・・・VBAからOutlookを使い、メール関係を処理するサンプルです
↑上記3つみたいなCreateObjectで他のアプリケーションを操作するサンプルが人気です。

Excel関係:
[エクセル ユーザーフォームを操作する]・・・エクセルでユーザーフォームを作成して入力などを行ってます
[エクセルからアクセスを操作する]・・・ExcelからAccessのマクロを起動してみました、
[エクセル関係 関数、その他]・・・その他Excel関係です

Access関係:
[アクセス ユーザーフォーム/サブフォーム 操作]・・・アクセスでフォームを使ったサンプルです
[アクセス レポート操作]・・・レポートを操作してみました
[アクセス クエリーやその他関数]・・・あまりまとまってませんが、スポット的な単体関数の解説です

その他:VBAの共通関数やテキストファイルの操作など
[テキストファイルの操作(Open,Close,Print,Input)]・・・普通のテキストファイルを使ったサンプルです

Blog:[三流君の作業日記]/ [objIEを使用したサンプルコードを見る]/ 広告-[通販人気商品の足跡]

質問や要望など メッセージを送る(三流君に連絡する)

三流プログラマーのKen3 が 皆さんの質問にお答えします
と カッコつけて言っても、実力不足ですべての質問に回答することはできないのが現実なのですが、できる範囲で 三流的な逃げ手 や 解決方法 を探します(回答します)。

感想や質問・要望・苦情など 三流君へメッセージを送る。
時間的余裕のある要望・質問・苦情の場合は、下記のフォームからメッセージを送ることができます。

あなたのお名前(ニックネーム):さん
返信は?: 不用(HP更新を待つ) , E-mail→ アドレス:に返事をもらいたい



(感想や質問・要望 メッセージはHPで記事に載せることがあります。)

急ぎで連絡がほしい、そんな時は:[三流君連絡先]に連絡してください。



[トップページへ 戻る] / [VBA TOP] / [WebBrowser IEの操作 TOPへ]