ここから本文です

webページからのデータ取得について(VBA) VBA初心者です。 見よう見まね...

mam********さん

2011/9/110:12:00

webページからのデータ取得について(VBA)

VBA初心者です。
見よう見まねでyahooの日経平均株価(現在値)を
取得するPGMを作成したのですが、
再度取得しにいくと前回と同じ値が帰ってきてしまいます。

エクセルと再起動させると正しく取得出来るのですが
2回目以降は駄目です。

何が問題なのでしょう?

Sub source_get()

Const TITLE = "20分ディレイ株価"
Const ITEM_COUNT = 1
Dim strURL As String
Dim strID As String
Dim strPass As String
Dim strRetVal As String
Dim re As RegExp
Dim mc As MatchCollection
Dim i As Long
Dim j As Long


strURL = "http://stocks.finance.yahoo.co.jp/stocks/detail/?code=998407.O"
strID = ""
strPass = ""

If Not GetHtmlSource(strURL, strRetVal, False, strID, strPass) Then
MsgBox "情報を取得できませんでした。", vbCritical
Exit Sub
End If

Set re = CreateObject("VBScript.RegExp")
re.Pattern = ">[^<>/]+<"
re.Global = True
Set mc = re.Execute(strRetVal)

For i = 0 To mc.Count - 1
If InStr(mc(i), TITLE) Then
j = i + ITEM_COUNT

Exit For
End If
Next

For i = i + 1 To j
Cells(4, 3) = Mid$(mc(i), 2, Len(mc(i)) - 2)
Next

Set re = Nothing

End Sub


Private Function GetHtmlSource(ByVal strURL As String, _
ByRef strRetVal As String, _
Optional ByVal isSJIS As Boolean, _
Optional ByVal strID As String, _
Optional ByVal strPass As String) As Boolean

Dim oHttp As Object

On Error Resume Next

Set oHttp = CreateObject("MSXML2.XMLHTTP")
If (Err.Number <> 0) Then
Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
End If
On Error GoTo 0

If oHttp Is Nothing Then
MsgBox "XMLHTTP オブジェクトを作成できませんでした。", vbCritical
Exit Function
End If

oHttp.Open "GET", strURL, False

oHttp.Send

If (oHttp.Status < 200 Or oHttp.Status >= 300) Then Exit Function

strRetVal = oHttp.responseText

Set oHttp = Nothing

GetHtmlSource = True
End Function

閲覧数:
7,869
回答数:
2
お礼:
100枚

違反報告

ベストアンサーに選ばれた回答

kab********さん

2011/9/114:59:36

porihikoletskunさんがご指摘のように、まさに・・・

更新の有無問わず2度目の場合はキャッシュを返す!

というのが、MSXML2.XMLHTTPのデフォルト仕様だそうです

参考ページ
http://komet163.blog36.fc2.com/blog-entry-7.html

ボクも質問を読んだ時に、なんかしらどっかでデータが残ってんだろうなぁ~・・・ と思い
MSXML2.XMLHTTP MSXML.XMLHTTPRequest リフレッシュ ← こんな感じでグーグルさんに問い合わせて
たどり着いたページです

そんなわけで・・・

Private Function GetHtmlSource(ByVal strURL As String, _
ByRef strRetVal As String, _
Optional ByVal isSJIS As Boolean, _
Optional ByVal strID As String, _
Optional ByVal strPass As String) As Boolean

Dim oHttp As Object

On Error Resume Next

Set oHttp = CreateObject("MSXML2.XMLHTTP")
If (Err.Number <> 0) Then
Set oHttp = CreateObject("MSXML.XMLHTTPRequest")
End If
On Error GoTo 0

If oHttp Is Nothing Then
MsgBox "XMLHTTP オブジェクトを作成できませんでした。", vbCritical
Exit Function
End If

oHttp.Open "GET", strURL, False

'***付け加え*********************************************************
oHttp.setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
'******************************************************************

oHttp.Send

If (oHttp.Status < 200 Or oHttp.Status >= 300) Then Exit Function

strRetVal = oHttp.responseText

Set oHttp = Nothing

GetHtmlSource = True
End Function

質問者さんのコードに ***付け加え*** を加えただけで、確実に最新のページ内容を読み込んでくれるようになりました

質問した人からのコメント

2011/9/1 18:19:44

降参 「結果が前回と同じ=初期化がNG」
という固定概念にとらわれ、色々調べたのですがさっぱりでした。

今後タイムスケジュール等を組み込んでいく為、
webページは開かずに組もうと思っています。
制限文字数で最初に書くことが出来きず申し訳ありません。

お二方にベストアンサーをお渡ししたいところなのですが、
上記の理由によりkabukunmanさんにお渡しします。
porihikoletskunさんごめんなさい。

回答ありがとうございました!

ベストアンサー以外の回答

1〜1件/1件中

por********さん

2011/9/113:40:44

こんにちは。
コードには、ミスがないようです。
可能性があるとしたら、「ブラウザーのキャッシュ」を読み込みしている、ということです。

とりあえず、ということでしたら
Sub source_get()

Const TITLE = "20分ディレイ株価"
Const ITEM_COUNT = 1
Dim strURL As String
Dim strID As String
Dim strPass As String
Dim strRetVal As String
'Dim re As RegExp
'Dim mc As MatchCollection
Dim i As Long
Dim j As Long




strURL = "http://stocks.finance.yahoo.co.jp/stocks/detail/?code=998407.O"
strID = ""
strPass = ""

Set ie = CreateObject("internetexplorer.application")
ie.navigate strURL

If Not GetHtmlSource(strURL, strRetVal, False, strID, strPass) Then
MsgBox "情報を取得できませんでした。", vbCritical
Exit Sub
End If

Set re = CreateObject("VBScript.RegExp")
re.Pattern = ">[^<>/]+<"
re.Global = True
Set mc = re.Execute(strRetVal)

For i = 0 To mc.Count - 1
If InStr(mc(i), TITLE) Then
j = i + ITEM_COUNT

Exit For
End If
Next



Cells(2, 3) = Mid$(mc(i - 3), 2, Len(mc(i - 3)) - 2)
Cells(2, 4) = Mid$(mc(i - 2), 2, Len(mc(i - 2)) - 2)
Cells(4, 3) = Mid$(mc(i + 1), 2, Len(mc(i + 1)) - 2)

Set ie = Nothing


と、IEのオブジェクトで、ページを開いてしまって、現在のページを読み込みして処理、最後には捨てる。
というのだったら、こんなコードになります。

ページの再読み込みだと、リクエストの為の文字列をきちんと作成して、そのxmlをポストすることになるので、
今回のようなリクエストの文字列が無い場合は、回避対策で、webページを表示させて、いいかと。
(人によっては、webページを開いてから、ターゲットタグを探して、取得する、という処理のひともいます)

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる