使用 Excel vba 在 Investing.com 中进行网页抓取

Question

我对vba一无所知。仅使用宏记录器。 我需要将网页中的数据下载到 Excel 电子表格中，而我的 vba 知识我无法做到。

特别是我想做一个宏下载到Excel的一个页面的数据表：https://www.investing.com/equities/cellnex-telecom-historical-data

必须根据时间、日期范围和顺序来配置此下载。

步骤如下： 1.- 目标是将“CLNX 历史数据”表中的数据复制到 Excel 电子表格中。 2.- 该下载应该通过调用“Term”在下拉菜单中选择“Monthly”来完成。 3.- 下载是通过预先选择过去 2 年的日期范围进行的。 4.- 最后，按“最大值”列按降序排列表格。 5.- 选择期限、日期范围和顺序后，将“CLNX 历史数据”表中的数据复制到 Excel 电子表格中。

我已尝试使用宏记录器，但无法配置术语、日期范围或排序。

有人可以帮我吗？

感谢您的帮助。

代码：

Sub DataInvesting()

Dim IE As Object

Set IE = CreateObject("InternetExplorer.Application")

IE.navigate "https://www.investing.com/equities/cellnex-telecom-historical-data"

Do Until IE.readyState = 4

DoEvents

Loop

IE.Document.getElementsByClassName("newInput selectBox float_lang_base_1")(0).Value = "Monthly"

IE.Visible = True

Set IE = Nothing

Set appIE = Nothing

End Sub

Answer 1

我刚刚测试了下面的代码并且它可以工作，而不是每次我们需要运行这个宏时都创建一个 Internet Explorer 的实例，我们将使用 xmlhttp 请求。只需复制整个代码并将其粘贴到 vba 中的模块中即可。不要忘记添加对 Microsoft HTML 对象库和 Microsoft XML v6.0 的引用（工具/参考）。

Option Explicit
Sub Export_Table()

'Html Objects---------------------------------------'
 Dim htmlDoc As MSHTML.HTMLDocument
 Dim htmlBody As MSHTML.htmlBody
 Dim ieTable As MSHTML.HTMLTable
 Dim Element As MSHTML.HTMLElementCollection


'Workbooks, Worksheets, Ranges, LastRow, Incrementers ----------------'
 Dim wb As Workbook
 Dim Table As Worksheet
 Dim i As Long

 Set wb = ThisWorkbook
 Set Table = wb.Worksheets("Sheet1")

 '-------------------------------------------'
 Dim xmlHttpRequest As New MSXML2.XMLHTTP60  '
 '-------------------------------------------'


 i = 2

'Web Request --------------------------------------------------------------------------'
 With xmlHttpRequest
 .Open "POST", "https://www.investing.com/instruments/HistoricalDataAjax", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "X-Requested-With", "XMLHttpRequest"
.send "curr_id=951681&smlID=1695217&header=CLNX+Historical+Data&st_date=01%2F01%2F2017&end_date=03%2F01%2F2019&interval_sec=Monthly&sort_col=date&sort_ord=DESC&action=historical_data"


 If .Status = 200 Then

        Set htmlDoc = CreateHTMLDoc
        Set htmlBody = htmlDoc.body

        htmlBody.innerHTML = xmlHttpRequest.responseText

        Set ieTable = htmlDoc.getElementById("curr_table")

        For Each Element In ieTable.getElementsByTagName("tr")
            Table.Cells(i, 1) = Element.Children(0).innerText
            Table.Cells(i, 2) = Element.Children(1).innerText
            Table.Cells(i, 3) = Element.Children(2).innerText
            Table.Cells(i, 4) = Element.Children(3).innerText
            Table.Cells(i, 5) = Element.Children(4).innerText
            Table.Cells(i, 6) = Element.Children(5).innerText
            Table.Cells(i, 7) = Element.Children(6).innerText

            i = i + 1
        DoEvents: Next Element
 End If
End With


Set xmlHttpRequest = Nothing
Set htmlDoc = Nothing
Set htmlBody = Nothing
Set ieTable = Nothing
Set Element = Nothing

End Sub

Public Function CreateHTMLDoc() As MSHTML.HTMLDocument
    Set CreateHTMLDoc = CreateObject("htmlfile")
End Function

Answer 2

我无法对此进行测试，因为尽管设置了免费帐户，但它一直说密码错误。受够了 5 次密码重置和同样的问题，并怀疑它想要我的社交媒体详细信息。

以下大致概述了我会考虑的步骤，尽管很可能需要一些定时等待。

Option Explicit
'VBE > Tools > References:
' Microsoft Internet Controls
Public Sub Info()
    Dim ie As New InternetExplorer  
    Const URL As String  = ""https://www.investing.com/equities/cellnex-telecom-historical-data""
    With ie
        .Visible = True
        .Navigate2 URL

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

        .document.querySelector(".login").Click

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

        .Navigate2 URL

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


        With .document.querySelector("#loginFormUser_email")
            .Focus
            .Value = "Bob@gmail.com"
        End With
        With .document.querySelector("#loginForm_password")
            .Focus
            .Value = "systemSucksDoesn'tAcceptMyPassword"
        End With

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

        .document.querySelector("[onclick*=submitLogin]").Click

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

        .document.querySelector("#data_interval").Click
        .document.querySelector("[value=Monthly]").Click
        With .document.querySelector("#picker")
            .Focus
            .Value = "03/08/2017 - 03/08/2019"
            .FireEvent "onchange"
        End With

        'TODO Sorting column when clarified which column
        .document.querySelector("[title='Download Data']").Click

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

        Stop
        .Quit
    End With
End Sub

Answer 3

试试这个。

Sub Web_Table_Option()
    Dim HTMLDoc As New HTMLDocument
    Dim objTable As Object
    Dim lRow As Long
    Dim lngTable As Long
    Dim lngRow As Long
    Dim lngCol As Long
    Dim ActRw As Long
    Dim objIE As InternetExplorer
    Set objIE = New InternetExplorer
    objIE.Navigate "https://www.investing.com/equities/cellnex-telecom-historical-data"

    Do Until objIE.ReadyState = 4 And Not objIE.Busy
        DoEvents
    Loop
    Application.Wait (Now + TimeValue("0:00:03")) 'wait for java script to load
    HTMLDoc.body.innerHTML = objIE.Document.body.innerHTML
    With HTMLDoc.body
        Set objTable = .getElementsByTagName("curr_table")
        For lngTable = 0 To objTable.Length - 1
            For lngRow = 0 To objTable(lngTable).Rows.Length - 1
                For lngCol = 0 To objTable(lngTable).Rows(lngRow).Cells.Length - 1
                    ThisWorkbook.Sheets("Sheet1").Cells(ActRw + lngRow + 1, lngCol + 1) = objTable(lngTable).Rows(lngRow).Cells(lngCol).innerText
                Next lngCol
            Next lngRow
            ActRw = ActRw + objTable(lngTable).Rows.Length + 1
        Next lngTable
    End With
    objIE.Quit
End Sub