VBAプログラミング：CNBCから株価を取得する関数

Google Financeから現物や先物の株価を取得してExcelに反映させるプログラム組んでたんですが、Google Financeの先物は更新が滞ったりして、あまり信頼できないとわかりました。なので、ＣＮＢＣから取得するようにプログラムを書き換えました。

Function GetStockCNBCMain(strStock As String, Hour As Integer) As String
' Summary:引数で指定された銘柄コードのプレマーケットの株価をCNBCで取得する。
' Argument:strStock as string
' return value:GetStock as string

    Dim strURL As String    ' URL
    Dim oHttp As Object     ' オブジェクト
    Dim strHtml As String   ' 取得データ
    Dim strStart As String  ' 検索文字列の開始位置
    Dim strEnd As String    ' 検索文字列の終了位置
    Dim longStart, longEnd, longStrLength As Long
    Dim strGet As String
    
    ' URLを指定
    strURL = "https://www.cnbc.com/quotes/" + strStock
    ' オブジェクト生成し変数oHttpへ代入
    Set oHttp = CreateObject("Microsoft.XMLHTTP")
    ' openメソッドで、GET、False(同期通信)を設定
    oHttp.Open "GET", strURL, False
    ' サーバーから oHttpへ送信
    oHttp.send
    ' 受信データを変数strHtmlへ入れる
    strHtml = oHttp.responseText
    
    Set oHttp = Nothing
    
    Select Case Hour
    Case MarketHour.Pre
        ' 時間前取引まで読み飛ばす
        strStart = InStr(strHtml, ""<span class=""QuoteStrip-extendedLabel"">Before Hours: </span>"") '工事中
        longStart = Val(strStart)
        ' 開始文字をずらす
        longStart = longStart + Len("<span class=""QuoteStrip-extendedLabel"">Before Hours: </span>")'工事中
    Case MarketHour.After
        strStart = InStr(strHtml, "<span class=""QuoteStrip-extendedLabel"">After Hours: </span>")
        longStart = Val(strStart)
        ' 開始文字をずらす
        longStart = longStart + Len("<span class=""QuoteStrip-extendedLabel"">After Hours: </span>")
    Case MarketHour.Closed
        strStart = InStr(strHtml, "<div class=""QuoteStrip-lastTradeTime"">Close</div>")
        longStart = Val(strStart)
        ' 開始文字をずらす
        longStart = longStart + Len("<div class=""QuoteStrip-lastTradeTime"">Close</div>")
    Case Else
        strStart = InStr(strHtml, "<div class=""QuoteStrip-lastTradeTime"">")
        longStart = Val(strStart)
        ' 開始文字をずらす
        longStart = longStart + Len("<div class=""QuoteStrip-lastTradeTime"">")
    End Select
    
    ' 株価を取得する
    strStart = InStr(longStart, strHtml, "<span class=""QuoteStrip-lastPrice"">")
    longStart = Val(strStart)
    ' 開始文字をずらす
    longStart = longStart + Len("<span class=""QuoteStrip-lastPrice"">")
    
    strEnd = InStr(longStart, strHtml, "</span>")
    
    ' strStart及びstrEndを整数型へ変換
    longEnd = Val(strEnd)
    ' 取得する文字列の長さ
    longStrLength = longEnd - longStart
    
    ' 文字列抜き出し
    strGet = Mid(strHtml, longStart, longStrLength)
    
    '関数の戻値を設定
    GetStockCNBCMain = strGet

End Function
Function GetPercentCNBC(strStock As String) As Double
' Summary:引数で指定された銘柄コードの株価の騰落率＋1.0をＣＮＢＣで取得する。
' Argument:strStock as string
' return value:GetPercentCNBC as double

    Dim strURL As String    ' URL
    Dim oHttp As Object     ' オブジェクト
    Dim strHtml As String   ' 取得データ
    Dim strStart As String  ' 検索文字列の開始位置
    Dim strEnd As String    ' 検索文字列の終了位置
    Dim longStart, longEnd, longStrLength As Long
    Dim strGet As String
    
    ' URLを指定
    strURL = "https://www.cnbc.com/quotes/" + strStock
    ' オブジェクト生成し変数oHttpへ代入
    Set oHttp = CreateObject("Microsoft.XMLHTTP")
    ' openメソッドで、GET、False(同期通信)を設定
    oHttp.Open "GET", strURL, False
    ' サーバーから oHttpへ送信
    oHttp.send
    ' 受信データを変数strHtmlへ入れる
    strHtml = oHttp.responseText
    
    Set oHttp = Nothing
    
    longStart = 1
    
    ' 騰落率を取得する
    strStart = InStr(longStart, strHtml, "</span><span> (<!-- -->")
    longStart = Val(strStart)
    ' 開始文字をずらす
    longStart = longStart + Len("</span><span> (<!-- -->")
    
    strEnd = InStr(longStart, strHtml, "%<!-- -->)</span>")
    
    ' strStart及びstrEndを整数型へ変換
    longEnd = Val(strEnd)
    ' 取得する文字列の長さ
    longStrLength = longEnd - longStart
    
    ' 文字列抜き出し
    strGet = Mid(strHtml, longStart, longStrLength)
    
    doublePercent = Val(strGet)
    '関数の戻値を設定

    GetPercentCNBC = doublePercent / 100 + 1#
End Function

↓↓↓こちをらのブログも是非ごらんください。