I try to extract or pull data from HTML Element into Excel using VBA code:https://drive.google.com/file/d/1_fGBlOLzMxmV3r-WwC8klcBNB7wUuJN2/view?usp=sharing
My idea is to extract and pull the exchange rate data in yellow highlight as from the HTML website:https://drive.google.com/file/d/1LACA6quFz_Am6mGVjGQ39xvehtX1sybB/view?usp=sharing
Unfortunately, when i try to run the code, it compile the error as "run-time error 445" and "object doesn't support this action"
Appreciate someone can guide me to find out what is the error. Below is my full VBA code:
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
New Regex VBA code as below:
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
If I got you right, the following should fetch you the content you wanna grab from there.
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
Reference to add to the library:
Microsoft HTML Object Library
This are the type of output the above script produces:
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
You can do string manipulation like:
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
or apply regex to scoop out the desired portion from the above results.