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

  3. #3
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    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.

  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
  •