Question

我在编码时遇到麻烦，无法再工作。

我在下面发布了我正在研究的编码逻辑。我将Excel工作表导入了首页上显示的国家/地区的葡萄牙。

但是

<a id="ctl00_ContentPlaceHolder1_defaultUC1_CurrencyMatrixAllCountries1_LinkButton1" class="btn-group btn-group-sm" href="javascript:__doPostBack('ctl00$ContentPlaceHolder1$defaultUC1$CurrencyMatrixAllCountries1$LinkButton1','')">
   <button type = "button" class = "btn btn-default">
      <i class = "glyphicon glyphicon-plus"> </ i>
   </ button>
</a>

如何编写doPostBack来完成我的工作？我浏览了stackoverflow主页并尝试了各种尝试和错误，但我无法完成。

Option Explicit
Public Sub New_Listing()

Application.ScreenUpdating = False

Dim IE As New InternetExplorer
Const MAX_WAIT_SEC As Long = 5

Dim http As New MSXML2.XMLHTTP60
Dim html As New HTMLDocument
Dim ws As Worksheet
Dim sResponse0 As String
Dim g As Integer

Set http = CreateObject("MSXML2.XMLHTTP")
Set ws = ThisWorkbook.Worksheets("Sheet1")

Dim url As String

url = "https://tradingeconomics.com/"

    With IE
        .Visible = True
        .navigate "https://tradingeconomics.com/"

        While .Busy Or .readyState < 4: DoEvents: Wend
    End With

Dim tarTable As HTMLTable
Dim hTable As HTMLTable

For Each tarTable In IE.document.getElementsByTagName("table")
    If InStr(tarTable.ID, "ctl00_ContentPlaceHolder1_defaultUC1_CurrencyMatrixAllCountries1_GridView1") <> 0 Then
    Set hTable = tarTable
    End If
Next

    Dim startRow As Long
    Dim tRow As Object, tCell As Object, tr As Object, td As Object, r As Long, c As Long

    r = startRow
    With ws
        Set tRow = hTable.getElementsByTagName("tr")
        ReDim arr0(tRow.Length - 1, 0)
        For Each tr In tRow
            r = r + 1
            Set tCell = tr.getElementsByTagName("td")

            If tCell.Length > UBound(arr0, 2) Then
            ReDim Preserve arr0(tRow.Length - 1, tCell.Length)
            End If

            c = 1
            For Each td In tCell
                arr0(r - 1, c - 1) = td.innerText
                c = c + 1
            Next td

        Next tr

        Dim k As Integer
        Dim i As Integer

        k = 0
        For i = LBound(arr0, 1) To UBound(arr0, 1)
            .Cells(2 + k, 2) = arr0(i, 0)
            .Cells(2 + k, 3) = arr0(i, 1)
            .Cells(2 + k, 4) = arr0(i, 2)
            .Cells(2 + k, 5) = arr0(i, 3)
            .Cells(2 + k, 6) = arr0(i, 4)
            .Cells(2 + k, 7) = arr0(i, 5)
            .Cells(2 + k, 8) = arr0(i, 6)
            .Cells(2 + k, 9) = arr0(i, 7)
            k = k + 1
        Next i
    End With

    With IE
        .Visible = True
        .document.querySelector("a.btn-group btn-group-sm[href='javascript:__doPostBack('ctl00$ContentPlaceHolder1$defaultUC1$CurrencyMatrixAllCountries1$LinkButton1','')']").Click
    End With

Set tRow = Nothing: Set tCell = Nothing: Set tr = Nothing: Set td = Nothing
Set hTable = Nothing: Set tarTable = Nothing

Application.ScreenUpdating = True

End Sub

我已经完成了到葡萄牙的工作，如何修复它以获得下一个数据，捷克共和国？如果您能给我有关如何修改编码的详细信息，我将不胜感激。我很快就学会了vba，所以遇到很多困难。

enter image description here

Answer 1

Czech Republic值是一个值集的一部分，该值集是在单击网页本身中的按钮后从服务器返回的，您必须通过VBA代码模拟对此按钮的单击，等待IE获取结果，然后继续执行您的代码：

这是用于获取下一组值的按钮的HTML：

<button type="button" class="btn btn-default">...

使用它来模拟点击并等待获取结果：

IE.document.getElementsByClassName("btn-default")(0).Click
Application.Wait(Now + TimeValue("0:00:05"))

之后，您将能够通过VBA代码读取Czech Republic和下一组值。

Answer 2

Internet Explorer

在IE上-一次性获得所有结果（整个世界），包括链接。

基于条件的超时等待：

Option Explicit
Public Sub GetInfo()
    Dim IE As New InternetExplorer, ws As Worksheet, clipboard As Object, t As Date
    Const MAX_WAIT_SEC As Long = 5
    Const URL = "https://tradingeconomics.com/"

    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

    With IE
        .Visible = True
        .navigate URL

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

        With .document
            .querySelector("[value=world]").Selected = True
            .querySelector("select").FireEvent "onchange"
            t = Timer
            Do
            DoEvents
            If Timer - t > MAX_WAIT_SEC Then Exit Do
            Loop While .getElementById("ctl00_ContentPlaceHolder1_defaultUC1_CurrencyMatrixAllCountries1_ParameterContinent").Value <> "world"

            clipboard.SetText .getElementById("ctl00_ContentPlaceHolder1_defaultUC1_CurrencyMatrixAllCountries1_GridView1").outerHTML
            clipboard.PutInClipboard
        End With
        .Quit
        ws.Cells(1, 1).PasteSpecial
    End With
End Sub

基于显式等待：

Option Explicit

Public Sub GetInfo()
    Dim IE As New InternetExplorer, ws As Worksheet, clipboard As Object
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Const URL = "https://tradingeconomics.com/"
    With IE
        .Visible = True
        .navigate URL

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

        With .document
            .querySelector("[value=world]").Selected = True
            .querySelector("select").FireEvent "onchange"

             Application.Wait Now + TimeSerial(0, 0, 5)

             clipboard.SetText .getElementById("ctl00_ContentPlaceHolder1_defaultUC1_CurrencyMatrixAllCountries1_GridView1").outerHTML
             clipboard.PutInClipboard
        End With
        .Quit
        ws.Cells(1, 1).PasteSpecial
    End With
End Sub

基本硒

使用selenium basic很容易，并且有足够的时间供postBack更新页面。硒基本安装后，通过VBE>工具>引用>硒类型库添加引用。更多硒信息[here]。下面一口气获取了所有世界数据。

Option Explicit

Public Sub GetInfo()
    Dim d As WebDriver, ws As Worksheet, clipboard As Object
    Set d = New ChromeDriver
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set clipboard = GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Const URL = "https://tradingeconomics.com/"

    With d
        .Start "Chrome"
        .get URL
        .FindElementByCss("[value=world]").Click

        Application.Wait Now + TimeSerial(0, 0, 5)

        clipboard.SetText .FindElementById("ctl00_ContentPlaceHolder1_defaultUC1_CurrencyMatrixAllCountries1_GridView1").Attribute("outerHTML")
        clipboard.PutInClipboard
        .Quit
        ws.Cells(1, 1).PasteSpecial
    End With
End Sub

与VBA中的doPostBack＆href相关的单击

2 个答案: