获取表格数据使用”msxml2.xmlhttp”。

huangapple go评论63阅读模式
英文:

How to get data from table using "msxml2.xmlhttp"

问题

I have translated the code part for you:

Sub Get_Prices()

    Dim sWeb_URL As String
    Dim oHTML_Content As Object, oTbl As Object, tr As Object, td As Object, oTBody As Object
    Dim r As Long, c As Long, arr

    With Sheets(20)
        sWeb_URL = "https://www.lbma.org.uk/prices-and-data/precious-metal-prices#/table"
        Set oHTML_Content = CreateObject("htmlfile")

        'get entire webpage content into HTMLFile Object
        With CreateObject("msxml2.xmlhttp")
            .Open "GET", sWeb_URL, False
            .send
            oHTML_Content.body.innerHTML = .responseText
        End With

        'Set oTbl = oHTML_Content.getElementsByTagName("-index1")
        'Set oTbl = oHTML_Content.getElementById("-index1")
        'Set oTbl = oHTML_Content.getElementsByClassName("pepper-responsive-table")
        'Set oTbl = oHTML_Content.getElementsByClassName("pepper-responsive-table").getElementsByTagName("tbody")(0).getElementsByTagName("tr")(0)
        'Set oTbl = oHTML_Content.getElementsByClassName("pepper-responsive-table")(0).getElementsByTagName("tr")(2)
        Set oTbl = oHTML_Content.getElementsByTagName("tbody")

        For Each tr In oTbl
            c = 1
            For Each td In tr.Cells
                .Cells(r, c) = td.innerText
                c = c + 1
            Next td
            r = r + 1
        Next tr
            
    End With

End Sub

Please note that this code attempts to scrape data from a webpage, but the webpage structure may change over time, so you might need to adjust it accordingly.

英文:

HTMLI am trying to get data from a webpage https://www.lbma.org.uk/prices-and-data/precious-metal-prices#/table
Seemed simple with all the q and a examples online but I'm flapping around like a kipper and reduced to guessing after much trial and error. Could someone please show where I am going wrong?

The aim,,, my wbook data has always been manually updated regularly so the aim now is to download say the first 10 rows of gold prices only and preferably without the Euro data just date, USD and GBP. Headers are not required either just data.

Here is the HTML and code so far. Errors encountered have been 'Object required' and 'Object doesn't support,,,' etc.

Sub Get_Prices()

    Dim sWeb_URL As String
    Dim oHTML_Content As Object, oTbl As Object, tr As Object, td As Object, oTBody As Object
    Dim r As Long, c As Long, arr

    With Sheets(20)
        sWeb_URL = "https://www.lbma.org.uk/prices-and-data/precious-metal-prices#/table"
        Set oHTML_Content = CreateObject("htmlfile")

        ''get entire webpage content into HTMLFile Object
        With CreateObject("msxml2.xmlhttp")
            .Open "GET", sWeb_URL, False
            .send
            oHTML_Content.body.innerHTML = .responseText
        End With

        'Set oTbl = oHTML_Content.getElementsByTagName("-index1")
        'Set oTbl = oHTML_Content.getElementById("-index1")
        'Set oTbl = oHTML_Content.getElementsByClassName("pepper-responsive-table")
        'Set oTbl = oHTML_Content.getElementsByClassName("pepper-responsive-table").getElementsByTagName("tbody")(0).getElementsByTagName("tr")(0)
        'Set oTbl = oHTML_Content.getElementsByClassName("pepper-responsive-table")(0).getElementsByTagName("tr")(2)
        Set oTbl = oHTML_Content.getElementsByTagName("tbody")

        For Each tr In oTbl
            c = 1
            For Each td In tr.Cells
                .Cells(r, c) = td.innerText
                c = c + 1
            Next td
            r = r + 1
        Next tr
            
    End With

End Sub

答案1

得分: 3

以下是您提供的代码的翻译:

'在阅读了 @Zwenn 的评论后,我编写了以下代码并将值带入了表格。

'此公共函数在一个模块中
--------------------------------------------------------
Public Function fetch_prices(ByRef AM, ByRef PM, ByVal afterMonth As String) As String
   Dim c As Integer, a As Long, lb As Integer
   Dim URL() As Variant    ', fileSaveTo() As Variant
   
   '将文件路径更改为任何有效的本地路径
   'fileSaveTo = Array(".\AM_PRICES.TXT", ".\PM_PRISES.TXT")
   URL = Array("https://prices.lbma.org.uk/json/gold_am.json?r=84419867", _
                      "https://prices.lbma.org.uk/json/gold_pm.json?r=796011502")
   lb = LBound(URL)
                      
    With CreateObject("msxml2.xmlhttp")
       For c = lb To UBound(URL)
         .Open "GET", URL(c), False
         .send
            'Call WriteToTextFile(fileSaveTo(c), .responseText)
         a = InStrRev(.responseText, afterMonth)
         If a > 0 Then
            If (c = lb) Then
               AM = Mid(.responseText, a)
            Else
               PM = Mid(.responseText, a)
            End If
         End If
      Next
   End With
End Function


'工作表模块中的私有子程序
----------------------------------------------------
Private Sub get_prices(afterTheMont As String)
   Const d = """d"""
   Dim AM As String, PM As String, pa As Long, lb As Long, rb As Long, rowId As Long, cc As Long
   Dim dt As String, values As Variant
   Call fetch_prices(AM, PM, afterTheMont)
   pa = 1: rowId = 3
  
  

    Do
      rowId = rowId + 1
      pa = InStr(pa + 1, AM, d)
      If (pa <= 0) Then Exit Do
      dt = Mid(AM, pa + 5, 10)
      Me.Cells(rowId, 1).Value2 = dt
      lb = InStr(pa, AM, "[")
      If lb > 0 Then
         rb = InStr(pa, AM, "]")
         If rb > 0 Then
            values = Split(Mid(AM, lb + 1, rb - lb - 1), ",")
            For cc = LBound(values) To UBound(values)
               Me.Cells(rowId, cc + 2).Value2 = values(cc)
            Next
         End If
      End If
   Loop
   
   rowId = 3
   Do
      rowId = rowId + 1
      pa = InStr(pa + 1, PM, d)
      If (pa <= 0) Then Exit Do
      dt = Mid(PM, pa + 5, 10)
      Me.Cells(rowId, 5).Value2 = dt
      lb = InStr(pa, PM, "[")
      If lb > 0 Then
         rb = InStr(pa, PM, "]")
         If rb > 0 Then
            values = Split(Mid(PM, lb + 1, rb - lb - 1), ",")
            For cc = LBound(values) To UBound(values)
               Me.Cells(rowId, cc + 6).Value2 = values(cc)
            Next
         End If
      End If
   Loop

   
End Sub

'通过命令按钮点击事件使用
Private Sub CommandButton1_Click()
   '这意味着在表格中显示下个月的首个存在数据的第一天的价格
   Call get_prices("2023-04")
End Sub

请注意,上述代码是您提供的VBA(Visual Basic for Applications)代码的翻译。

英文:

After reading @Zwenn's comment I wrote the following code and brought the values to the sheet.

&#39;THIS PUBLIC FUNCTION IN A MODULE
--------------------------------------------------------
Public Function fetch_prices(ByRef AM, ByRef PM, ByVal afterMonth As String) As String
   Dim c As Integer, a As Long, lb As Integer
   Dim URL() As Variant    &#39;, fileSaveTo() As Variant
   
   &#39;change the files path to any valid local path
   &#39;fileSaveTo = Array(&quot;.\AM_PRICES.TXT&quot;, &quot;.\PM_PRISES.TXT&quot;)
   URL = Array(&quot;https://prices.lbma.org.uk/json/gold_am.json?r=84419867&quot;, _
                      &quot;https://prices.lbma.org.uk/json/gold_pm.json?r=796011502&quot;)
   lb = LBound(URL)
                      
    With CreateObject(&quot;msxml2.xmlhttp&quot;)
       For c = lb To UBound(URL)
         .Open &quot;GET&quot;, URL(c), False
         .send
            &#39;Call WriteToTextFile(fileSaveTo(c), .responseText)
         a = InStrRev(.responseText, afterMonth)
         If a &gt; 0 Then
            If (c = lb) Then
               AM = Mid(.responseText, a)
            Else
               PM = Mid(.responseText, a)
            End If
         End If
      Next
   End With
End Function


&#39;THE PRIVATE SUBs IN THE SHEET MODULE
----------------------------------------------------
Private Sub get_prices(afterTheMont As String)
   Const d = &quot;&quot;&quot;d&quot;&quot;&quot;
   Dim AM As String, PM As String, pa As Long, lb As Long, rb As Long, rowId As Long, cc As Long
   Dim dt As String, values As Variant
   Call fetch_prices(AM, PM, afterTheMont)
   pa = 1: rowId = 3
   
  

    Do
      rowId = rowId + 1
      pa = InStr(pa + 1, AM, d)
      If (pa &lt;= 0) Then Exit Do
      dt = Mid(AM, pa + 5, 10)
      Me.Cells(rowId, 1).Value2 = dt
      lb = InStr(pa, AM, &quot;[&quot;)
      If lb &gt; 0 Then
         rb = InStr(pa, AM, &quot;]&quot;)
         If rb &gt; 0 Then
            values = Split(Mid(AM, lb + 1, rb - lb - 1), &quot;,&quot;)
            For cc = LBound(values) To UBound(values)
               Me.Cells(rowId, cc + 2).Value2 = values(cc)
            Next
         End If
      End If
   Loop
   
   rowId = 3
   Do
      rowId = rowId + 1
      pa = InStr(pa + 1, PM, d)
      If (pa &lt;= 0) Then Exit Do
      dt = Mid(PM, pa + 5, 10)
      Me.Cells(rowId, 5).Value2 = dt
      lb = InStr(pa, PM, &quot;[&quot;)
      If lb &gt; 0 Then
         rb = InStr(pa, PM, &quot;]&quot;)
         If rb &gt; 0 Then
            values = Split(Mid(PM, lb + 1, rb - lb - 1), &quot;,&quot;)
            For cc = LBound(values) To UBound(values)
               Me.Cells(rowId, cc + 6).Value2 = values(cc)
            Next
         End If
      End If
   Loop

   
End Sub

&#39;usage via command button click event
Private Sub CommandButton1_Click()
   &#39;it means show in sheet the prices from the first day exist data of the next month
   Call get_prices(&quot;2023-04&quot;)
End Sub

获取表格数据使用”msxml2.xmlhttp”。

huangapple
  • 本文由 发表于 2023年5月13日 12:34:29
  • 转载请务必保留本文链接:https://go.coder-hub.com/76241090.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定