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.
Code: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
I'd have liked to use GetElementsByClassName but that doesn't seem to work with late binding, so a Heath Robinson approach:
Code: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
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