Web scraping in Investing.com with Excel vba - excel

Question

I have no knowledge of vba. Only the macro recorder is used.
I need to download the data from a web page to an Excel spreadsheet and with my knowledge of vba I am not capable.
In particular, what I want to do a macro to download to Excel a data table of the page: https://www.investing.com/equities/cellnex-telecom-historical-data
This download would have to be configured in terms of time, date range and ordering.
The steps would be the following:
1.- The objective is to copy the data from the "CLNX historical data" table to an Excel spreadsheet.
2.- That download should be done by previously selecting "Monthly" in the drop-down menu by calling "Term".
3.- That the download is made by previously selecting the range of dates for the last 2 years.
4.- Finally, order the table in descending order by the column "Maximum".
5.- Once the term, the date range and the order are selected, copy the data from the "CLNX historical data" table to an Excel spreadsheet.
I have tried with the macro recorder but I am not able to configure the term, the date range or the ordering.
Could someone help me?
Thanks for your help.
The code:
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

I have just tested the following code and it works, instead of creating an instance of internet explorer every time we need to run this macro, we will use xmlhttp requests. Just copy the entire code and paste it into a module in vba. Don't forget to add references (Tools/References) to Microsoft HTML Object Library and 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

I can't test this as despite setting up a free account it keeps saying the password is wrong. Fed up with 5 password resets and same problem and suspect it want my social media details.
The following broadly outlines steps I would consider though some timed waits are most likely needed.
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

Try this.
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