VBA從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這一翻譯得到0的寶貴幫助。

Answer 1

你得到0主要原因是，肯德基從未等於0以外的任何東西我改變val.mono爲val單聲道和我改變變量類型爲字符串，而不是整數。下面的代碼以最好的方式知道如何使用後期綁定。

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

我發現這個代碼有點慢，但工作。此外，我發現該值已經給後加權平均，然後我糾正去年通過「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中提取它，該網站有一個應該更快地工作的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