Sub ie_test()
Dim objIE As Object 'IEオブジェクト参照用
Dim strCOMMENT As String 'コメントの入力
'INPUTBOXでデータをもらう
strCOMMENT = InputBox("何か一言コメントを入れてください")
If strCOMMENT = "" Then
MsgBox "何か文字を入れてくださいね"
Exit Sub '途中で抜ける
End If
Application.WindowState = xlMinimized '入力後Excelを最小化、下に下げる
'IEを起動する
Set objIE = CreateObject("InternetExplorer.application") 'IEのオブジェクトを作る
objIE.Visible = True '見えるようにする(お約束)
'.Navigate で 指定したURLを開く
objIE.Navigate "http://ken3-info.blog.ocn.ne.jp/test/2007/05/post_4291_1.html"
'表示終了まで待つ .Busy(忙しい)間 と.ReadyState(ステータス)が4以外の時 ループ
Do While objIE.Busy = True
DoEvents '特に何もしないで.Busyの状態が変わるまで待つ
Loop
Do While objIE.ReadyState <> 4
DoEvents '特に何もしないで.ReadyStateの状態が4に変わるまで待つ
Loop
'htmlドキュメント フォーム(0番目) アイテム(MEMO)に転記(代入)する。
objIE.Document.Forms(0).Item("MEMO").Value = strCOMMENT
'親のオブジェクトをチェックする
Dim objITEM As Object
' .parentElement を代入する 親のオブジェクトを代入
Set objITEM = objIE.Document.all.Item("MEMO").parentElement
Debug.Print objITEM.Tagname 'タグの名前
objITEM.Submit
End Sub
Sub test_0313_DT_parentElement()
'銘柄コードの入力
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
'DTデータから[始値]を探す
Dim objParent As Object
'.tags("DT") で DTタグを抜き出す
Dim objDT As Object 'DTの格納用
Set objDT = objIE.document.all.tags("DT") '.tags("DT")でDTタグを抜く
'いろいろなループを作れるけど、カウンタ n でまわしてみる
Dim n As Integer
For n = 0 To objDT.Length - 1 'カウンタ0から.length - 1 までまわす。
If Left(objDT(n).InnerHTML, 3) = "始値<" Then '[始値<]を探す
Set objParent = objDT(n).parentElement '親オブジェクトを代入
Debug.Print ".tagname = " & objParent.tagname
Debug.Print ".OuterHTML = [" & objParent.OuterHTML & "]"
MsgBox objParent.OuterHTML '親オブジェクトのHTMLを画面で確認
Exit For
End If
Next n
'終了処理
'後始末(使った食器はキレイにしてから戸棚に戻そうね)
Set objDT = Nothing
objIE.Quit '終了処理
Set objIE = Nothing
MsgBox "終了しました"
End Sub
Sub test_0314_KABUKA_GET_TEST()
'銘柄コードの入力
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
'DTデータから[始値] などを探す
Dim objParent As Object '親のタグ オブジェクト
Dim objTagSTRONG As Object 'STRONG の タグを保存する変数
'.tags("DT") で DTタグを抜き出す
Dim objDT As Object 'DTの格納用
Set objDT = objIE.document.all.tags("DT") '.tags("DT")でDTタグを抜く
'いろいろなループを作れるけど、カウンタ n でまわしてみる
Dim n As Integer
For n = 0 To objDT.Length - 1 'カウンタ0から.length - 1 までまわす。
If Left(objDT(n).InnerHTML, 3) = "始値<" Then '[始値<]を探す
Set objParent = objDT(n).parentElement '親オブジェクトを代入
'次にSTRONG 強調表示の値を探す
Set objTagSTRONG = objParent.all.tags("STRONG") '.tags("STRONG")でSTRONGタグを抜く
'値の表示
Debug.Print "始値 = " & objTagSTRONG.Item(0).InnerText 'STRONG タグ のテキスト
End If
If Left(objDT(n).InnerHTML, 3) = "高値<" Then '[高値<]を探す
Set objParent = objDT(n).parentElement '親オブジェクトを代入
'次にSTRONG 強調表示の値を探す
Set objTagSTRONG = objParent.all.tags("STRONG") '.tags("STRONG")でSTRONGタグを抜く
'値の表示
Debug.Print "高値 = " & objTagSTRONG.Item(0).InnerText 'STRONG タグ のテキスト
End If
If Left(objDT(n).InnerHTML, 3) = "安値<" Then '[安値<]を探す
Set objParent = objDT(n).parentElement '親オブジェクトを代入
'次にSTRONG 強調表示の値を探す
Set objTagSTRONG = objParent.all.tags("STRONG") '.tags("STRONG")でSTRONGタグを抜く
'値の表示
Debug.Print "安値 = " & objTagSTRONG.Item(0).InnerText 'STRONG タグ のテキスト
End If
If Left(objDT(n).InnerHTML, 4) = "出来高<" Then '[出来高<]を探す
Set objParent = objDT(n).parentElement '親オブジェクトを代入
'次にSTRONG 強調表示の値を探す
Set objTagSTRONG = objParent.all.tags("STRONG") '.tags("STRONG")でSTRONGタグを抜く
'値の表示
Debug.Print "出来高 = " & objTagSTRONG.Item(0).InnerText 'STRONG タグ のテキスト
End If
Next n
'終了処理
'後始末(使った食器はキレイにしてから戸棚に戻そうね)
Set objDT = Nothing
'objIE.Quit '終了処理 ← テストで残したかったので、コメントにした。
'Set objIE = Nothing
MsgBox "終了しました"
End Sub
ポイントは、
If Left(objDT(n).InnerHTML, 3) = "始値<" Then '[始値<]を探す
で、目的のDTタグを見つけます。みつけたら
Set objParent = objDT(n).parentElement '親オブジェクトを代入
で、親のタグ DL を.parentElementでセットします。
'次にSTRONG 強調表示の値を探す
Set objTagSTRONG = objParent.all.tags("STRONG")
で、 '.tags("STRONG")でSTRONGタグを抜く
'値の表示
Debug.Print "始値 = " & objTagSTRONG.Item(0).InnerText
探した、STRONG タグ のテキスト を 表示できました。
End If
IE を 起動して Yahooファイナンス 始値 高値 安値 出来高 を探す http://www.youtube.com/watch?v=3kE-MqdfPAo
Sub test_0314_KABUKA_GET_TEST()
'銘柄コードの入力
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
'DTデータから[始値] などを探す
Dim objParent As Object '親のタグ オブジェクト
Dim objTagSTRONG As Object 'STRONG の タグを保存する変数
'.tags("DT") で DTタグを抜き出す
Dim objDT As Object 'DTの格納用
Set objDT = objIE.document.all.tags("DT") '.tags("DT")でDTタグを抜く
'いろいろなループを作れるけど、カウンタ n でまわしてみる
Dim n As Integer
Dim x As Integer
Dim BOX As Variant
BOX = Array("始値", "安値", "高値", "出来高")
For n = 0 To objDT.Length - 1 'カウンタ0から.length - 1 までまわす。
For x = 0 To 3
If Left(objDT(n).InnerHTML, 1 + Len(BOX(x))) = BOX(x) & "<" Then '[始値<]を探す
Set objParent = objDT(n).parentElement '親オブジェクトを代入
'次にSTRONG 強調表示の値を探す
Set objTagSTRONG = objParent.all.tags("STRONG") '.tags("STRONG")でSTRONGタグを抜く
'値の表示
Debug.Print BOX(x) & " = " & objTagSTRONG.Item(0).InnerText 'STRONG タグ のテキスト
End If
Next x
Next n
'終了処理
'後始末(使った食器はキレイにしてから戸棚に戻そうね)
Set objDT = Nothing
'objIE.Quit '終了処理 ← テストで残したかったので、コメントにした。
'Set objIE = Nothing
MsgBox "終了しました"
End Sub
ポイントは、
BOX = Array("始値", "安値", "高値", "出来高")
で、変数BOXを文字列で初期化します。
For n = 0 To objDT.Length - 1 'カウンタ0から.length - 1 までまわす。
あとは、0から3のループを作り、
For x = 0 To 3
If Left(objDT(n).InnerHTML, 1 + Len(BOX(x))) = BOX(x) & "<" Then
↑BOX(x)を使用して、条件文を変更しました。
Set objParent = objDT(n).parentElement '親オブジェクトを代入
'次にSTRONG 強調表示の値を探す
Set objTagSTRONG = objParent.all.tags("STRONG") '.tags("STRONG")でSTRONGタグを抜く
↑ここは、変わりなく、単純に親タグからSTRONGを探してます。
'値の表示
Debug.Print BOX(x) & " = " & objTagSTRONG.Item(0).InnerText
↑ここは、見出しの文字を Box(x) で使用してます。
End If
Next x
Next n
読者の声で 初めから 書けよ。。。と言われそうな。。。
03/14 Array 関数を使用して処理をまとめる http://www.youtube.com/watch?v=Faq5AuMRliA
/*
* 7.エラー処理を入れる 危ないポイント、見つからない時の処理
*/
三流プログラムの特徴として、
エラー処理を省いてます。
コードを公開するなら、丁寧に作らないと、
三流コード被害者の会 から また、クレームの書き込みとメールをもらうかなぁ。
今回は、危ないポイントを1つ
※それでもエラー処理は1つだけしかやらないのかよ。
危ないのは、ココ
Set objParent = objDT(n).parentElement '親オブジェクトを代入
'次にSTRONG 強調表示の値を探す
Set objTagSTRONG = objParent.all.tags("STRONG")
↑.tags("STRONG")でSTRONGタグを抜く
ここで、もし、STRINGのタグ、指定したタグが無かったら?
指定したタグが無い時のテストをしてみます。
Set objTagSTRONG = objParent.all.tags("KEN3")
とか、ありえないタグでテストすると、エラーが発生します。
エラー発生時、デバッグでとめて、
? objTagSTRONG.Length
と確認すると、0が返ってきます。
.Length で 抜き出した数がわかるので、0以外の判断でいけそうです。
If objTagSTRONG.Length <> 0 Then
Debug.Print BOX(x) & " = " & objTagSTRONG.Item(0).InnerText
End If
と、単純にチェックしました。
三流コード被害者の会 会員の皆様にお知らせします。。。
Sub test_0315_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, "G") = strTITLE 'G列に 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
'C列:始値 D列:高値 E列:安値 F列:出来高 をセット
'DTデータから[始値] などを探す
Dim objParent As Object '親のタグ オブジェクト
Dim objTagSTRONG As Object 'STRONG の タグを保存する変数
'.tags("DT") で DTタグを抜き出す
Dim objDT As Object 'DTの格納用
Set objDT = objIE.document.all.tags("DT") '.tags("DT")でDTタグを抜く
'いろいろなループを作れるけど、カウンタ n でまわしてみる
Dim x As Integer
Dim BOX As Variant
BOX = Array("始値", "安値", "高値", "出来高") '条件を初期化
For n = 0 To objDT.Length - 1 'カウンタ0から.length - 1 までまわす。
For x = 0 To 3
If Left(objDT(n).InnerHTML, 1 + Len(BOX(x))) = BOX(x) & "<" Then '[始値<]を探す
Set objParent = objDT(n).parentElement '親オブジェクトを代入
'次にSTRONG 強調表示の値を探す
Set objTagSTRONG = objParent.all.tags("STRONG") '.tags("STRONG")でSTRONGタグを抜く
'値の表示
If objTagSTRONG.Length <> 0 Then
Cells(y, 3 + x) = CLng(objTagSTRONG.Item(0).InnerTEXT)
Debug.Print BOX(x) & " = " & objTagSTRONG.Item(0).InnerTEXT 'STRONG タグ のテキスト
End If
End If
Next x
Next n
Next y '行のループ、次の行へ
'終了処理
objIE.Quit '今回は.QUITで使ったIEを閉じてみた。
Set objIE = Nothing
End Sub
今回は、
ドキュメント、タグのオブジェクトで、
.parentElement で親のタグを参照?
を書いてみました。
サンプルファイル(Excel2003 Windows XP IE7でテスト)
http://www.ken3.org/vba/lzh/IE_TEST_0313.zip
zipを解答解凍して中のIE_TEST_0313.xlsを実行しながら確認してみてください。
読者の声:
だから、.parentElement で親のタグを参照 は わかったけど、
使用すると便利なメリットがわからなかった。
ギク、、、確かに今回の処理では、メリット無かったですね。
※おぃおぃ、なんで発行したんだよ。
例えば、今回の取り出しなら、
> <dl>
> <dd class="ymuiEditLink mar0"><strong>472</strong><span class="date yjSt">(09:03)</span></dd>
> <dt class="title">始値<a class="tips alignPos" href="" onMouseOver="showTips('ha
まず、DLのタグでループを作り、
その下の、DTを取り出し、
DT内に 始値や安値・高値・出来高があるかチェック
見つかったら、STRONGタグを取り出す。
取り出したSTRONGタグのInnerTextが値です。
と、前回やった、.tags("タグ") で OKだし、こっちのほうがスッキリしてる?
'.tags("") で タグを抜き出す
Dim objDT As Object 'DTの格納用
Dim objDL As Object
Dim objTagSTRONG As Object 'STRONG の タグを保存する変数
'いろいろなループを作れるけど、カウンタ n でまわしてみる
Dim n As Integer
Dim x As Integer
Dim BOX As Variant
BOX = Array("始値", "安値", "高値", "出来高")
Set objDL = objIE.document.all.tags("DL") '.tags("DL")でDLタグを抜く
For n = 0 To objDL.Length - 1 'カウンタ0から.length - 1 までまわす。
Set objDT = objDL(n).all.tags("DT") '.tags("DT")を探す DTタグを抜く
If objDT.Length <> 0 Then
For x = 0 To 3
If Left(objDT.Item(0).InnerHTML, 1 + Len(BOX(x))) = BOX(x) & "<" Then '[始値<]を探す
'次にSTRONG 強調表示の値を探す
Set objTagSTRONG = objDL(n).all.tags("STRONG") '.tags("STRONG")でSTRONGタグを抜く
'値の表示
If objTagSTRONG.Length <> 0 Then
Debug.Print BOX(x) & " = " & objTagSTRONG.Item(0).InnerTEXT 'STRONG タグ のテキスト
End If
End If
Next x
End If
Next n
↑、まぁ、こっちも正解ってことで。(こっちのほうがわかり易いかも???)
↓で、また、話しながら修正したのが↓今度は成功したのかなぁ(笑)