Scrape economic data from investing website-CodePudding

I am working on a code to get data from :

Enter the URL

Wait for the webpage to load and then pick the table that you want. This website took awhile to load, but it did work for me.

Choose "Load" which goes directly to the sheet, or "Transform Data" to manipulate the data in Power Query. There are many options in power query such as split columns, filter data, Calculate Columns and ...

CodePudding user response：

ok I have found a way by using xmlhttprequest, I looked at the tables and rows within the website "inspect" and it seem to be working (code below) however it seem the investing.com is blocking the "show more" option to get more data. Does anyone know how to overcome this? see attached

enter image description here

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/economic-calendar/core-durable-goods-orders-59", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "X-Requested-With", "XMLHttpRequest"
.send ""

'pair id curr_id=951681&smlID=1695217



 If .Status = 200 Then

        Set htmlDoc = CreateHTMLDoc
        Set htmlBody = htmlDoc.body

        htmlBody.innerHTML = xmlHttpRequest.responseText

        Set ieTable = htmlDoc.getElementById("eventHistoryTable59")

        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