webページからのデータ取得について（VBA） ＶＢＡ初心者です。 見よう見まねでya...

mame_benson_1977さん

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

ＶＢＡ初心者です。
見よう見まねでyahooの日経平均株価（現在値）を
取得するＰＧＭを作成したのですが、
再度取得しにいくと前回と同じ値が帰ってきてしまいます。

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

何が問題なのでしょう？

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