VBA Get number from HTML

Question

このウェブサイトからXBT/USDの最終価値を抽出するのは、https://www.kraken.com/charts です。別の質問からこのコードを得て、それを必要に応じてうまく編集しようとしました。

Option Explicit 
    Sub Get_Number() 

'Open website 
    Dim IE As New SHDocVw.InternetExplorer 
    IE.Visible = True 

    IE.Navigate "https://www.kraken.com/charts" 

    Do While IE.ReadyState <> READYSTATE_COMPLETE 
    Loop 
'Clicl on XBT/USD in order to change the value from EUR to USD 
    IE.Document.getElementById("pairselect-button").Click 
    IE.Document.getElementsByClassName("currpairs")(1).Click 

'Extract USD last value 
    Dim kfc As Integer 
    Dim oHTML_Element As IHTMLElement 
     For Each oHTML_Element In IE.Document.getElementsByTagName("div") 
      If oHTML_Element.className = "val.mono" Then 
       kfc = oHTML_Element.Value 
      End If 
     Next 
    Range("A2").Value = kfc 
    End Sub 

HTMLコード要素にこの後

<div class="val mono" data-val="2324.999" name="last" style="color: rgb(0, 178, 86);">$2,738.5<span class="deczeros">00</span></div> 

を検査するためによると、私はあなたの貴重な助けを事前に$ 2,738.5

感謝のA2のinteadに0を得ました。

Answer 1

あなたが0を得た主な理由は、kfcが0以外の値に決して等しくないということでした。私はval.monoをval monoに変更し、変数型をintegerではなくstringに変更しました。最善の方法で私は後でバインディングでどのように知っている以下のコード。

Sub Get_Number() 

    'Open website 
    Dim IE As Object 
    Dim event_created As Object 
    Set IE = CreateObject("InternetExplorer.Application") 
    IE.Visible = True 

    IE.navigate "https://www.kraken.com/charts" 

    Do While IE.readyState <> 4 
    Application.Wait TimeValue("00:00:01") 
    Loop 
    Application.Wait TimeValue("00:00:01") 
    'Clicl on XBT/USD in order to change the value from EUR to USD 
    Set event_created = IE.document.createEvent("HTMLEvents") 
    event_created.initEvent "click", True, False 
    DoEvents 
    IE.document.getElementById("pairselect-button").dispatchEvent event_created 
    IE.document.getElementsByClassName("currpairs")(1).dispatchEvent event_created 

    'Extract USD last value 
    Dim kfc As String 
    Dim oHTML_Element As Object 
    Dim divs As Object 
    Set divs = IE.document.getElementsByTagName("div") 
    For Each oHTML_Element In divs 
     If oHTML_Element.className = "val mono" Then 
      kfc = oHTML_Element.textContent 
     End If 
    Next 
    Range("A2").Value = kfc 
End Sub 

Answer 2

このコードでは少し遅くなっていましたが、機能しました。また、私は値が、その後WEIGHTED AVGを与えていたことがわかった私は、「getElementsByName("last")」で「getElementsByTagName("div")」を変える最後まで修正しても、あなたの文字列の提案で補正し、以下のようにInnerTextプロパティで働い：

Option Explicit 
Sub Get_Number1() 

'Open website 
    Dim IE As New SHDocVw.InternetExplorer 
    IE.Visible = True 
    IE.Navigate "https://www.kraken.com/charts" 
    Do While IE.ReadyState <> READYSTATE_COMPLETE 
    Loop 
'Click on XBT/USD in order to change the value from EUR to USD 
    IE.Document.getElementById("pairselect-button").Click 
    IE.Document.getElementsByClassName("currpairs")(1).Click 

''Extract USD last value 
    Dim kfc As String 
    Dim oHTML_Element As IHTMLElement 
     For Each oHTML_Element In IE.Document.getElementsByName("last") 
      If oHTML_Element.className = "val mono" Then 
       kfc = oHTML_Element.innerText 
      End If 
     Next 
    Debug.Print kfc 
End Sub 

どうもありがとうございました

Answer 3

HTMLから抽出するのではなく、そのWebサイトにはより迅速に対応するAPIアクセス権があります。

私は以下のコードで早期バインディングを使用しましたが、必要に応じて遅延バインディングに切り替えることができます。

また、私は最後の取引とその取引の時刻（UTC時刻）の両方を返却することを選択しました。私はこれらを抽出するために正規表現を使用しました。

他にも公開API呼び出しがあります。たとえば、時間ではなく最後の取引の価格だけに興味がある場合は、ティッカー情報を入手することができます。

詳細については、Kraken API Help Pageを参照してください。

結果はA1とB1に書き込まれますが、後続の行に順番に結果を書き込むルーチンを設定できます。おそらく、

のようなもの：

Option Explicit 
Sub LastTrade() 
'Microsoft Windows HTTP Services 5.1 
'Microsoft VBScript Regular Expressions 5.5 

    Dim httpRequest As WinHttpRequest 
    Dim sResponse As String 
    Dim sInfo As String 

    Dim RE As RegExp, MC As MatchCollection 

    Dim D As Double 

Const sUrl As String = "https://api.kraken.com/0/public/Trades" 
sInfo = "?pair=XBTUSD" 

Set httpRequest = New WinHttpRequest 
httpRequest.Open "Get", sUrl & sInfo 

httpRequest.Send 
httpRequest.WaitForResponse 

sResponse = httpRequest.ResponseText 

Set RE = New RegExp 
With RE 
    .Global = False 
    .IgnoreCase = False 
    .Pattern = "\[""(\d+\.\d+)"",[^,]+,(\d+\.\d+)[^]]+]],""last""" 

    If .Test(sResponse) = True Then 
     Set MC = .Execute(sResponse) 
     [a1].NumberFormat = "$#,###.000" 
     [a1] = MC(0).SubMatches(0) 

     D = MC(0).SubMatches(1) 'Unix time 
     D = D/86400 + CDbl(#1/1/1970#) 

     With [b1] 
      .NumberFormat = "dd-mmm-yyyy hh:mm:ss" 
      .Value = D 
     End With 

    Else 
     [a1] = Right(sResponse, 100) 
    End If 
End With 

Set httpRequest = Nothing 

End Sub