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

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

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

问题

I have translated the code part for you:

  1. Sub Get_Prices()
  2. Dim sWeb_URL As String
  3. Dim oHTML_Content As Object, oTbl As Object, tr As Object, td As Object, oTBody As Object
  4. Dim r As Long, c As Long, arr
  5. With Sheets(20)
  6. sWeb_URL = "https://www.lbma.org.uk/prices-and-data/precious-metal-prices#/table"
  7. Set oHTML_Content = CreateObject("htmlfile")
  8. 'get entire webpage content into HTMLFile Object
  9. With CreateObject("msxml2.xmlhttp")
  10. .Open "GET", sWeb_URL, False
  11. .send
  12. oHTML_Content.body.innerHTML = .responseText
  13. End With
  14. 'Set oTbl = oHTML_Content.getElementsByTagName("-index1")
  15. 'Set oTbl = oHTML_Content.getElementById("-index1")
  16. 'Set oTbl = oHTML_Content.getElementsByClassName("pepper-responsive-table")
  17. 'Set oTbl = oHTML_Content.getElementsByClassName("pepper-responsive-table").getElementsByTagName("tbody")(0).getElementsByTagName("tr")(0)
  18. 'Set oTbl = oHTML_Content.getElementsByClassName("pepper-responsive-table")(0).getElementsByTagName("tr")(2)
  19. Set oTbl = oHTML_Content.getElementsByTagName("tbody")
  20. For Each tr In oTbl
  21. c = 1
  22. For Each td In tr.Cells
  23. .Cells(r, c) = td.innerText
  24. c = c + 1
  25. Next td
  26. r = r + 1
  27. Next tr
  28. End With
  29. 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.

  1. Sub Get_Prices()
  2. Dim sWeb_URL As String
  3. Dim oHTML_Content As Object, oTbl As Object, tr As Object, td As Object, oTBody As Object
  4. Dim r As Long, c As Long, arr
  5. With Sheets(20)
  6. sWeb_URL = "https://www.lbma.org.uk/prices-and-data/precious-metal-prices#/table"
  7. Set oHTML_Content = CreateObject("htmlfile")
  8. ''get entire webpage content into HTMLFile Object
  9. With CreateObject("msxml2.xmlhttp")
  10. .Open "GET", sWeb_URL, False
  11. .send
  12. oHTML_Content.body.innerHTML = .responseText
  13. End With
  14. 'Set oTbl = oHTML_Content.getElementsByTagName("-index1")
  15. 'Set oTbl = oHTML_Content.getElementById("-index1")
  16. 'Set oTbl = oHTML_Content.getElementsByClassName("pepper-responsive-table")
  17. 'Set oTbl = oHTML_Content.getElementsByClassName("pepper-responsive-table").getElementsByTagName("tbody")(0).getElementsByTagName("tr")(0)
  18. 'Set oTbl = oHTML_Content.getElementsByClassName("pepper-responsive-table")(0).getElementsByTagName("tr")(2)
  19. Set oTbl = oHTML_Content.getElementsByTagName("tbody")
  20. For Each tr In oTbl
  21. c = 1
  22. For Each td In tr.Cells
  23. .Cells(r, c) = td.innerText
  24. c = c + 1
  25. Next td
  26. r = r + 1
  27. Next tr
  28. End With
  29. End Sub

答案1

得分: 3

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

  1. '在阅读了 @Zwenn 的评论后,我编写了以下代码并将值带入了表格。
  2. '此公共函数在一个模块中
  3. --------------------------------------------------------
  4. Public Function fetch_prices(ByRef AM, ByRef PM, ByVal afterMonth As String) As String
  5. Dim c As Integer, a As Long, lb As Integer
  6. Dim URL() As Variant ', fileSaveTo() As Variant
  7. '将文件路径更改为任何有效的本地路径
  8. 'fileSaveTo = Array(".\AM_PRICES.TXT", ".\PM_PRISES.TXT")
  9. URL = Array("https://prices.lbma.org.uk/json/gold_am.json?r=84419867", _
  10. "https://prices.lbma.org.uk/json/gold_pm.json?r=796011502")
  11. lb = LBound(URL)
  12. With CreateObject("msxml2.xmlhttp")
  13. For c = lb To UBound(URL)
  14. .Open "GET", URL(c), False
  15. .send
  16. 'Call WriteToTextFile(fileSaveTo(c), .responseText)
  17. a = InStrRev(.responseText, afterMonth)
  18. If a > 0 Then
  19. If (c = lb) Then
  20. AM = Mid(.responseText, a)
  21. Else
  22. PM = Mid(.responseText, a)
  23. End If
  24. End If
  25. Next
  26. End With
  27. End Function
  28. '工作表模块中的私有子程序
  29. ----------------------------------------------------
  30. Private Sub get_prices(afterTheMont As String)
  31. Const d = """d"""
  32. Dim AM As String, PM As String, pa As Long, lb As Long, rb As Long, rowId As Long, cc As Long
  33. Dim dt As String, values As Variant
  34. Call fetch_prices(AM, PM, afterTheMont)
  35. pa = 1: rowId = 3
  36. Do
  37. rowId = rowId + 1
  38. pa = InStr(pa + 1, AM, d)
  39. If (pa <= 0) Then Exit Do
  40. dt = Mid(AM, pa + 5, 10)
  41. Me.Cells(rowId, 1).Value2 = dt
  42. lb = InStr(pa, AM, "[")
  43. If lb > 0 Then
  44. rb = InStr(pa, AM, "]")
  45. If rb > 0 Then
  46. values = Split(Mid(AM, lb + 1, rb - lb - 1), ",")
  47. For cc = LBound(values) To UBound(values)
  48. Me.Cells(rowId, cc + 2).Value2 = values(cc)
  49. Next
  50. End If
  51. End If
  52. Loop
  53. rowId = 3
  54. Do
  55. rowId = rowId + 1
  56. pa = InStr(pa + 1, PM, d)
  57. If (pa <= 0) Then Exit Do
  58. dt = Mid(PM, pa + 5, 10)
  59. Me.Cells(rowId, 5).Value2 = dt
  60. lb = InStr(pa, PM, "[")
  61. If lb > 0 Then
  62. rb = InStr(pa, PM, "]")
  63. If rb > 0 Then
  64. values = Split(Mid(PM, lb + 1, rb - lb - 1), ",")
  65. For cc = LBound(values) To UBound(values)
  66. Me.Cells(rowId, cc + 6).Value2 = values(cc)
  67. Next
  68. End If
  69. End If
  70. Loop
  71. End Sub
  72. '通过命令按钮点击事件使用
  73. Private Sub CommandButton1_Click()
  74. '这意味着在表格中显示下个月的首个存在数据的第一天的价格
  75. Call get_prices("2023-04")
  76. End Sub

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

英文:

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

  1. &#39;THIS PUBLIC FUNCTION IN A MODULE
  2. --------------------------------------------------------
  3. Public Function fetch_prices(ByRef AM, ByRef PM, ByVal afterMonth As String) As String
  4. Dim c As Integer, a As Long, lb As Integer
  5. Dim URL() As Variant &#39;, fileSaveTo() As Variant
  6. &#39;change the files path to any valid local path
  7. &#39;fileSaveTo = Array(&quot;.\AM_PRICES.TXT&quot;, &quot;.\PM_PRISES.TXT&quot;)
  8. URL = Array(&quot;https://prices.lbma.org.uk/json/gold_am.json?r=84419867&quot;, _
  9. &quot;https://prices.lbma.org.uk/json/gold_pm.json?r=796011502&quot;)
  10. lb = LBound(URL)
  11. With CreateObject(&quot;msxml2.xmlhttp&quot;)
  12. For c = lb To UBound(URL)
  13. .Open &quot;GET&quot;, URL(c), False
  14. .send
  15. &#39;Call WriteToTextFile(fileSaveTo(c), .responseText)
  16. a = InStrRev(.responseText, afterMonth)
  17. If a &gt; 0 Then
  18. If (c = lb) Then
  19. AM = Mid(.responseText, a)
  20. Else
  21. PM = Mid(.responseText, a)
  22. End If
  23. End If
  24. Next
  25. End With
  26. End Function
  27. &#39;THE PRIVATE SUBs IN THE SHEET MODULE
  28. ----------------------------------------------------
  29. Private Sub get_prices(afterTheMont As String)
  30. Const d = &quot;&quot;&quot;d&quot;&quot;&quot;
  31. Dim AM As String, PM As String, pa As Long, lb As Long, rb As Long, rowId As Long, cc As Long
  32. Dim dt As String, values As Variant
  33. Call fetch_prices(AM, PM, afterTheMont)
  34. pa = 1: rowId = 3
  35. Do
  36. rowId = rowId + 1
  37. pa = InStr(pa + 1, AM, d)
  38. If (pa &lt;= 0) Then Exit Do
  39. dt = Mid(AM, pa + 5, 10)
  40. Me.Cells(rowId, 1).Value2 = dt
  41. lb = InStr(pa, AM, &quot;[&quot;)
  42. If lb &gt; 0 Then
  43. rb = InStr(pa, AM, &quot;]&quot;)
  44. If rb &gt; 0 Then
  45. values = Split(Mid(AM, lb + 1, rb - lb - 1), &quot;,&quot;)
  46. For cc = LBound(values) To UBound(values)
  47. Me.Cells(rowId, cc + 2).Value2 = values(cc)
  48. Next
  49. End If
  50. End If
  51. Loop
  52. rowId = 3
  53. Do
  54. rowId = rowId + 1
  55. pa = InStr(pa + 1, PM, d)
  56. If (pa &lt;= 0) Then Exit Do
  57. dt = Mid(PM, pa + 5, 10)
  58. Me.Cells(rowId, 5).Value2 = dt
  59. lb = InStr(pa, PM, &quot;[&quot;)
  60. If lb &gt; 0 Then
  61. rb = InStr(pa, PM, &quot;]&quot;)
  62. If rb &gt; 0 Then
  63. values = Split(Mid(PM, lb + 1, rb - lb - 1), &quot;,&quot;)
  64. For cc = LBound(values) To UBound(values)
  65. Me.Cells(rowId, cc + 6).Value2 = values(cc)
  66. Next
  67. End If
  68. End If
  69. Loop
  70. End Sub
  71. &#39;usage via command button click event
  72. Private Sub CommandButton1_Click()
  73. &#39;it means show in sheet the prices from the first day exist data of the next month
  74. Call get_prices(&quot;2023-04&quot;)
  75. 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:

确定