Ошибка кода VBA при извлечении или извлечении данных с веб-сайта HTML

Question

Я пытаюсь извлечь или извлечь данные из элемента HTML в Excel с помощью кода VBA:https://drive.google.com/file/d/1_fGBlOLzMxmV3r-WwC8klcBNB7wUuJN2/view?usp=sharing

Моя идея состоит в том, чтобы извлечь и извлечь данные обменного курса, выделенные желтым цветом, как с веб-сайта HTML:https://drive.google.com/file/d/1LACA6quFz_Am6mGVjGQ39xvehtX1sybB/view?usp=sharing

К сожалению, когда я пытаюсь запустить код, он компилирует ошибку как "ошибка времени выполнения 445" и "объект не поддерживает это действие".

Признайте, что кто-то может помочь мне выяснить, в чем ошибка. Ниже мой полный код VBA:

Sub ExchangeRate()
Dim ieObj As InternetExplorer
Dim htmlEle As IHTMLElement
Dim htmlEleCollection As IHTMLElementCollection
Dim i As Integer

i = 1

Set ieObj = New InternetExplorer
ieObj.Visible = True
ieObj.navigate "https://secure.mas.gov.sg/msb/ExchangeRatesFeed.aspx?currency=jpy"

While ieObj.readyState <> 4 Or ieObj.Busy: DoEvents: Wend

Set htmlEleCollection = ieObj.document.getElementsByClassName("paditembox").Item(0).getElementsById("item").Value

For Each htmlEle In htmlEleCollection
    If htmlEle.Children.Length > 1 Then

       With ActiveSheet
           .Range("A" & i).Value = htmlEle.Children(0).textContent
           .Range("B" & i).Value = htmlEle.Children(1).textContent
           .Range("C" & i).Value = htmlEle.Children(2).textContent
           .Range("D" & i).Value = htmlEle.Children(3).textContent
           .Range("E" & i).Value = htmlEle.Children(4).textContent
           .Range("F" & i).Value = htmlEle.Children(5).textContent
           .Range("G" & i).Value = htmlEle.Children(6).textContent
       End With
    End If

    i = i + 1

Next htmlEle
End Sub

Новый код Regex VBA, как показано ниже:

Public Sub ExchangeRate()
    Dim results(), matches As Object, s As String
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", "https://eservices.mas.gov.sg/api/action/datastore/search.json?resource_id=5aa64bc2-d234-43f3-892e-2f587a220f74&fields=end_of_week,usd_sgd,jpy_sgd_100&limit=1&sort=end_of_week%20desc", False
        .send
        s = .responseText
    End With
    With CreateObject("VBScript.RegExp")
        .Global = True
        .IgnoreCase = False

        If .Pattern = "usd_sgd"":""(.*?)""" Then
           .MultiLine = True
           Set matches = .Execute(s)
           ReDim results(1 To matches.Count)

         ElseIf .Pattern = "jpy_sgd_100"":""(.*?)""" Then
            .MultiLine = True
            Set matches = .Execute(s)
            ReDim results(1 To matches.Count)
         End If

   End With
   Dim match As Variant, r As Long
   For Each match In matches
       r = r + 1
       results(r) = match.submatches(0)
   Next
   With ThisWorkbook.Worksheets("Sheet1")
       .Cells(2, 2).Resize(UBound(results), 1) = Application.Transpose(results)
       .Cells(2, 3).Resize(UBound(results), 1) = Application.Transpose(results)
   End With
End Sub

Answer 1

Если я вас понял, следующее должно доставить вам контент, который вы хотите получить оттуда.

Sub fetchData()
    Const Url = "https://secure.mas.gov.sg/msb/ExchangeRatesFeed.aspx?currency=jpy"
    Dim oItem As Object, Xdoc As New DOMDocument, R&

    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", Url, False
        .send
        Xdoc.LoadXML .responseText
    End With

    For Each oItem In Xdoc.getElementsByTagName("item")
        R = R + 1: Cells(R, 1) = oItem.getElementsByTagName("description")(0).Text
    Next oItem
End Sub

Ссылка для добавления в библиотеку:

Microsoft HTML Object Library

Это тип вывода, который производит приведенный выше сценарий:

100 Japanese Yen buys 1.3006 Singapore Dollars
100 Japanese Yen buys 1.3001 Singapore Dollars
100 Japanese Yen buys 1.2986 Singapore Dollars
100 Japanese Yen buys 1.2887 Singapore Dollars
100 Japanese Yen buys 1.2857 Singapore Dollars
100 Japanese Yen buys 1.2726 Singapore Dollars
100 Japanese Yen buys 1.2773 Singapore Dollars

Вы можете выполнять манипуляции со строками, например:

For Each oItem In Xdoc.getElementsByTagName("item")
    R = R + 1: Cells(R, 1) = Split(Split(oItem.getElementsByTagName("description")(0).Text, "buys ")(1), " ")(0)
Next oItem

или примените регулярное выражение, чтобы извлечь желаемую часть из приведенных выше результатов.