Dear friends,
I trust all is well.
I have already explained the needful in the attached Excel file, please review and amend my codes.
Thanks a lot and have a nice evening.
Dear friends,
I trust all is well.
I have already explained the needful in the attached Excel file, please review and amend my codes.
Thanks a lot and have a nice evening.
Hi friends,
Just to simplify my request, please amend the below code to:
Paste the imported data to first blank cell in column A.
Sub Extract_data() Dim URL As String, links_count As Integer Dim i As Integer, j As Integer, row As Integer Dim XMLHTTP As Object, html As Object Dim tr_coll As Object, tr As Object Dim td_coll As Object, td As Object Dim tbl As Object Dim td_col As Object links_count = 0 Dim LR0 As Long LR0 = Range("A" & Rows.Count).End(xlUp).row For i = 0 To links_count If Range("L1") <> "" And Range("Q1") <> "" Then URL = "https://www.xe.com/currencytables/?from=" & Range("Q1") & "&date=" & Format(Range("L1"), "yyyy-mm-dd") ' Date and currency are dynamic Set XMLHTTP = CreateObject("MSXML2.XMLHTTP") XMLHTTP.Open "GET", URL, False XMLHTTP.send Set html = CreateObject("htmlfile") html.body.innerHTML = XMLHTTP.responseText Set tbl = html.getElementsByTagName("Table") Set tr_coll = tbl(0).getElementsByTagName("TR") For Each tr In tr_coll j = 1 Set td_col = tr.getElementsByTagName("TD") For Each td In td_col Cells(row + 1, j).Value = td.innerText j = j + 1 Next row = row + 1 Next range("L1").delete shift:=xlup End If Next End Sub
Last edited by Bob Phillips; 04-14-2019 at 03:52 AM. Reason: Added code tags
I'd have liked to use GetElementsByClassName but that doesn't seem to work with late binding, so a Heath Robinson approach:
Sub Extract_data() Dim URL As String, links_count As Integer Dim i As Integer, j As Integer, row As Long Dim XMLHTTP As Object, html As Object Dim tr_coll As Object, tr As Object Dim td_coll As Object, td As Object Dim tbl As Object Dim td_col As Object links_count = 0 row = Range("A" & Rows.Count).End(xlUp).row For i = 0 To links_count If Range("L1") <> "" And Range("Q1") <> "" Then URL = "https://www.xe.com/currencytables/?from=" & Range("Q1") & "&date=" & Format(Range("L1"), "yyyy-mm-dd") ' Date and currency are dynamic Set XMLHTTP = CreateObject("MSXML2.XMLHTTP") XMLHTTP.Open "GET", URL, False XMLHTTP.send Set html = CreateObject("htmlfile") html.body.innerHTML = XMLHTTP.responseText mydate = Split(Split(XMLHTTP.responseText, "historicalRateTable-date"">")(1), "</p>")(0) Set tbl = html.getElementsByTagName("Table") Set tr_coll = tbl(0).getElementsByTagName("TR") For Each tr In tr_coll j = 1 Set td_col = tr.getElementsByTagName("TD") If td_col.Length > 0 Then For Each td In td_col Cells(row + 1, j).Value = td.innerText j = j + 1 Next Cells(row + 1, j).Value = mydate row = row + 1 End If Next End If Next End Sub
Last edited by p45cal; 04-14-2019 at 04:29 AM.
p45cal
Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.
Dear Mr. p4cal,
I would like to thank you for your valuable and nice code.
I have tried it, the result was perfect for even six months.
Bless U, appreciate it.
I would suggest to pin this thread so our colleagues will get the maximum use of it.
Khaled