回答下書き テストで数秒単位で書き変わる cyberagentfx の 値を取得してみた

下記の回答下書き、テストで cyberagentfx の 値を取得してみた

ブラウザのデータをエクセルで表示させるには？
ブラウザでは株価がJavascriptで表示されています。
それをリアルタイムでエクセルに反映させたいのですが、何か良い方法はないでしょうか？
(楽天のRSSを使う方法はなしで)
http://q.hatena.ne.jp/1309881508

いきなり、テストソース

/vba/zip/IE_Book20110707.zip に テストで使ったExcelのファイルを保存しました。
VBAの中身を変更したりして、遊んでみてください。

＞三流君 Ken3さん
具体的にはログイン後のサイトになるので例として
http://www.cyberagentfx.jp/
この上の方に表示されているレートを取得したいです。

Sub test()

    Dim objIE As Object '変数を定義します。
    
'IEの起動
    Set objIE = CreateObject("InternetExplorer.Application") 'オブジェクトを作成します。
    objIE.Visible = True      '可視、Trueで見えるようにします。
    
'処理したいページを表示します。
    objIE.Navigate "http://www.cyberagentfx.jp/"

'ページの表示完了を待ちます。
    While objIE.ReadyState <> 4 Or objIE.Busy = True '.ReadyState <> 4の間まわる。
        DoEvents  '重いので嫌いな人居るけど。
    Wend
    
'ページ表示後、テストで取得を繰り返す
    Dim y As Integer      '行カウンター
    Dim x As Integer      '列カウンター
    
    Dim c As String       '現在の値
    Dim strOLD As String  '前の値を覚える
    Dim time10 As Date    '10秒先を保存
    Dim tmp As Variant    'スペース区切りで分割させたかったので
    Dim i   As Integer    'ループのカウンター

    'ループ前 の 初期処理
    strOLD = "初期化"   'はじめは一致させたくないので、適当に初期化
    y = 5  '気分で５行目からテストでセット
    time10 = DateAdd("s", 20, Now())  '20秒後を計算
    Cells(3, 1) = time10 & " までテストする"
    
    While Now() <= time10   '20秒間だけ回りたいので
        c = objIE.document.all("ratebox").innerTEXT  'ID ratebox の テキストを取得
        If c <> strOLD Then  '前回の値と違ったら？※処理が重いと次を取りこぼすけど
            '値をセットする
            Cells(y, 1) = Now 'テストで時刻のセット
            Cells(y, 2) = Replace(c, vbCrLf, "")   '("ratebox").innerTEXT 元の値を改行消してテストでセット
            '改行で区切って、テストでセット
            tmp = Split(c, vbCrLf) '改行区切りで取り出す
            x = 3  '列３からセット
            For i = 0 To UBound(tmp)  'ループで配列をセット
                If Trim(tmp(i)) <> "" Then  'データありの時セットする、空白は飛ばす
                    Cells(y, x) = tmp(i)
                    x = x + 1
                End If
            Next i
      
            '次の準備
            y = y + 1  '次の位置へ
            strOLD = c '値を覚える
        End If
            
        'ふざけて現在時刻を描画？
        Cells(4, 1) = Now() & " テスト中"
        DoEvents
    
    Wend

    Cells(4, 1) = "テスト終了"

    objIE.Quit  'IEを閉じる

End Sub

↑少し、テストが甘いけど、こんな感じで、
id=ratebox から データを抜き出してみました。
※抜くといっても、
c = objIE.document.all("ratebox").innerTEXT で 改行で区切られたテーブルデータを取得して、
tmp = Split(c, vbCrLf) Splitで分解
For i = 0 To UBound(tmp) で ループ
If Trim(tmp(i)) <> "" Then 空白を判断してセットする
そんな感じでした。

テストのxlsを保存しました

vba/zip/IE_Book20110707.zip に テストで使ったExcelのファイルを保存しました。
VBAの中身を変更したりして、遊んでみてください。

ループしてる解説動画(笑)

いつもの動画解説です。
完成品を解説しているのに、いつものようにあわててます。

動画Yotubeで直接見るには→ http://www.youtube.com/watch?v=bomZyIH9p-w
www.youtube.com
↑※おいおい、解説がループしてて、無駄に長くなってるし、ポイントの解説は数秒でスルー。

何かの参考となれば幸いです。。。