Consulting

Results 1 to 4 of 4

Thread: Help: Importing currency exchange rates from website for 3 months

  1. #1

    Help: Importing currency exchange rates from website for 3 months

    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.
    Attached Files Attached Files

  2. #2
    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 xld; 04-14-2019 at 03:52 AM. Reason: Added code tags

  3. #3
    Knowledge Base Approver VBAX Guru
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    4,539
    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 - - - - -This is my signature, it appears after all my posts. Below is not directed at anyone in particular - so don't take offence! - (You might guess why it's there though)
    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.

  4. #4
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •