excelvbaweb-scrapingdata-import

Importing web data


I trying to import web data to excel using vba with below code but it seems like not working.Hopefully someone can help to fix this issue, thank you very much!

Sub ExchangeRate()
Dim ieObj As InternetExplorer
Dim htmlEle As IHTMLElement
Dim i As Integer

i = 1

Set ieObj = New InternetExplorer
ieObj.Visible = True
ieObj.navigate "https://www.imf.org/external/np/fin/ert/GUI/Pages/Report.aspx?CU=%27SGD%27&EX=REP&P=OneWeek&CF=Compressed&CUF=Period&DS=Ascending&DT=Blank"

Application.Wait Now + TimeValue("00:00:05")

For Each htmlEle In ieObj.document.getElementsByClassName("default").Item(2).getElementsByClassName("row1").Item(4)
    With ActiveSheet
      .Range("A" & i).Value = htmlEle.Children(0).textContent
      .Range("B" & i).Value = htmlEle.Children(1).textContent
      .Range("C" & i).Value = htmlEle.Children(3).textContent
      .Range("D" & i).Value = htmlEle.Children(4).textContent
    End With

    i = i + 1

Next htmlEle

End Sub

Solution

  • I think your issue is the line where your selecting the elements you want to read data from.

    Sub ExchangeRate()
    Dim ieObj As InternetExplorer
    Dim htmlEle As IHTMLElement
    Dim htmlEleCollection As IHTMLElementCollection
    Dim i As Integer
    
    i = 1
    
    Set ieObj = New InternetExplorer
    ieObj.Visible = True
    ieObj.navigate "https://www.imf.org/external/np/fin/ert/GUI/Pages/Report.aspx?CU=%27SGD%27&EX=REP&P=OneWeek&CF=Compressed&CUF=Period&DS=Ascending&DT=Blank"
    
    ' Application.Wait Now + TimeValue("00:00:05")
    While ieObj.readyState <> 4 Or ieObj.Busy: DoEvents: Wend
    ' using application.wait may work, but if it takes more than 5s for the page to load your code may fail.
    ' waiting for the browser to be ready is better.
    
    
    Set htmlEleCollection = ieObj.Document.getElementsByClassName("default").Item(0).getElementsByClassName("row1")
    ' i dont think you are selecting the right object with your code, i think this is what you were aiming for?
    
    For Each htmlEle In htmlEleCollection
        If htmlEle.Children.Length > 1 Then
    ' the table header has one child, the data rows have more
            With ActiveSheet
                .Range("A" & i).Value = htmlEle.Children(0).textContent
                .Range("B" & i).Value = htmlEle.Children(1).textContent
    '            .Range("C" & i).Value = htmlEle.Children(3).textContent
    '            .Range("D" & i).Value = htmlEle.Children(4).textContent
    ' children 3 and 4 do not exist when i view the page so your code will fail with them in.
            End With
        End If
    
        i = i + 1
    
    Next htmlEle
    ieObj.Quit
    End Sub