ExcelVBAでGoogle FinanceからS&P500とQQQの値を取得するプログラム。時間外の場合は、先物の騰落率から株価を予測。
少しバグを除去したので、バックアップの意味で公開しておきます。
Function GetStock(strStock As String) As String
' Summary:引数で指定された銘柄コードの株価をGoogleファイナンスで取得する。
' Argument:strStock as string
' return value:GetStock as string
Dim strURL As String ' URL
Dim oHttp As Object ' オブジェクト
Dim datHtml As String ' 取得データ
Dim strStart As String ' 検索文字列の開始位置
Dim strEnd As String ' 検索文字列の終了位置
Dim longStart, longEnd, longStrLength As Long
Dim strGet As String
' URLを指定
strURL = "https://www.google.com/finance/quote/" + strStock
' オブジェクト生成し変数oHttpへ代入
Set oHttp = CreateObject("Microsoft.XMLHTTP")
' openメソッドで、GET、False(同期通信)を設定
oHttp.Open "GET", strURL, False
' サーバーから oHttpへ送信
oHttp.send
' 受信データを変数datHtmlへ入れる
datHtml = oHttp.responseText
Set oHttp = Nothing
' 株価を取得する
strStart = InStr(datHtml, "<div class=""YMlKec fxKbKc"">")
longStart = Val(strStart)
' 開始文字をずらす
longStart = longStart + Len("<div class=""YMlKec fxKbKc"">")
strEnd = InStr(longStart, datHtml, "</div>")
' strStart及びstrEndを整数型へ変換
longEnd = Val(strEnd)
' 取得する文字列の長さ
longStrLength = longEnd - longStart
' 文字列抜き出し
strGet = Replace(Mid(datHtml, longStart, longStrLength), "$", "")
'関数の戻値を設定
GetStock = strGet
End Function
Function GetStockYesterday(strStock As String) As String
' Summary:引数で指定された銘柄コードの前日の株価をGoogleファイナンスで取得する。
' Argument:strStock as string
' return value:GetStock as string
Dim strURL As String ' URL
Dim oHttp As Object ' オブジェクト
Dim datHtml As String ' 取得データ
Dim strStart As String ' 検索文字列の開始位置
Dim strEnd As String ' 検索文字列の終了位置
Dim longStart, longEnd, longStrLength As Long
Dim strGet As String
' URLを指定
strURL = "https://www.google.com/finance/quote/" + strStock
' オブジェクト生成し変数oHttpへ代入
Set oHttp = CreateObject("Microsoft.XMLHTTP")
' openメソッドで、GET、False(同期通信)を設定
oHttp.Open "GET", strURL, False
' サーバーから oHttpへ送信
oHttp.send
' 受信データを変数datHtmlへ入れる
datHtml = oHttp.responseText
Set oHttp = Nothing
' 株価を取得する
strStart = InStr(datHtml, "<div class=""P6K39c"">")
longStart = Val(strStart)
' 開始文字をずらす
longStart = longStart + Len("<div class=""P6K39c"">")
strEnd = InStr(longStart, datHtml, "</div>")
' strStart及びstrEndを整数型へ変換
longEnd = Val(strEnd)
' 取得する文字列の長さ
longStrLength = longEnd - longStart
' 文字列抜き出し
strGet = Replace(Mid(datHtml, longStart, longStrLength), "$", "")
'関数の戻値を設定
GetStockYesterday = strGet
End Function
Public Function dstCheck(ByVal vDate As Date) As Boolean
Dim dstStart As Date, dstEnd As Date
dstStart = "March 8," & Year(vDate)
Do Until Weekday(dstStart) = 1
dstStart = dstStart + 1
Loop
dstEnd = "November 1," & Year(vDate)
Do Until Weekday(dstEnd) = 1
dstEnd = dstEnd + 1
Loop
dstCheck = vDate >= dstStart And vDate < dstEnd
End Function
Function GetPercent(strStock As String) As Double
strKabukaYesterday = Replace(GetStockYesterday(strStock), ",", "")
doubleKabukaYesterday = Val(strKabukaYesterday)
strKabuka = Replace(GetStock(strStock), ",", "")
doubleKabuka = Val(strKabuka)
GetPercent = doubleKabuka / doubleKabukaYesterday
End Function
Sub SetKabuka()
Dim strKabuka As String
Dim strDelta As String
Dim strKabukaYesterday As String
Dim doubleDelta As Double
Dim doubleKabuka As Double
Dim doubleKabukaYesterday As Double
Dim doublePercent As Double
Dim strStartTime As String
Dim strEndTime As String
strKabuka = GetStock("USD-JPY")
Cells(20, 2) = strKabuka
strKabuka = GetStock(".INX:INDEXSP")
Cells(20, 3) = strKabuka
strKabuka = GetStock("QQQ:NASDAQ")
Cells(20, 4) = strKabuka
' NY市場が閉まっていたら、先物の騰落を取得してエクセルに反映させる
If dstCheck(Date) Then
strStartTime = "22:30"
strEndTime = "5:00"
Else
strStartTime = "23:30"
strEndTime = "6:00"
End If
' NY市場が閉まっている場合は先物の値から株価を予想。
If CDate(Time) > CDate(strEndTime) And CDate(Time) < CDate(strStartTime) Then
' S&P500
Cells(19, 3) = Cells(20, 3)
Cells(20, 3) = Val(Cells(19, 3)) * GetPercent("ESW00:CME_EMINIS")
' NDX
Cells(19, 4) = Cells(20, 4)
Cells(20, 4).Value = Val(Cells(19, 4)) * GetPercent("NQW00:CME_EMINIS")
End If
End Sub
↓↓↓こちをらのブログも是非ごらんください。
