0

我尝试使用 VBA 代码从 HTML 元素中提取或提取数据到 Excel：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

新的正则表达式 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
4

1 回答 1

0

如果我没听错，以下内容应该会为您获取您想要从那里获取的内容。

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

或应用正则表达式从上述结果中挖出所需的部分。

于 2020-06-15T18:17:36.737 回答