简体   繁体   中英

Fetch data from website table using vba

I need to constantly update excel file with information, obtained from the following link (warning, ukrainian language): link to the Ministry of Finance web-site of Ukraine

Useful data is wrapped by the HTML tags <tbody></tbody> .

I need the similar code that retrieves the information from the table

Set htm = CreateObject("htmlFile")' #it doesn't work on mac os machine, but perfectly performs on windows
    With CreateObject("msxml2.xmlhttp")
        .Open "GET", <site_url_goes_here>, False
        .send
        htm.body.innerhtml = .responsetext
    End With

    With htm.getelementbyid("item")' <<<<<---what should I write here in order to parse data from the web-site table?
        Sheet2.Cells(Row, 4).Value = p
        For x = 1 To .Rows.Length - 1
            For y = 0 To .Rows(x).Cells.Length - 1
                Sheet2.Cells(Row, y + 1).Value = .Rows(x).Cells(y).innertext
            Next y
            Row = Row + 1
        Next x
    End With`

Below code will get the updated data from http://www.minfin.gov.ua in every 60 seconds.

Sub getData()

    Application.OnTime Now + TimeSerial(0, 0, 60), "finance_data"

End Sub

Private Sub finance_data()
    Dim url As String, lastRow As Long
    Dim XMLHTTP As Object, html As Object
    Dim tbl As Object, obj_tbl As Object
    Dim TR As Object, TD As Object
    Dim row As Long, col As Long

    lastRow = Range("A" & Rows.Count).End(xlUp).row

    url = "http://www.minfin.gov.ua/control/uk/publish/article?art_id=384069&cat_id=234036" & "&r=" & WorksheetFunction.RandBetween(1, 10000)

    Set XMLHTTP = CreateObject("MSXML2.XMLHTTP")
    XMLHTTP.Open "GET", url, False
    XMLHTTP.setRequestHeader "Content-Type", "text/xml"
    XMLHTTP.send

    Set html = CreateObject("htmlfile")
    html.body.innerHTML = XMLHTTP.ResponseText
    Set obj_tbl = html.getelementsbytagname("table")

    row = 1
    col = 1

    For Each tbl In obj_tbl
        If tbl.classname = "MsoNormalTable" Then
            Set TR = tbl.getelementsbytagname("TR")

            For Each obj_row In TR
                For Each TD In obj_row.getelementsbytagname("TD")
                    Cells(row, col) = TD.innerText
                    col = col + 1
                Next
                col = 1    ' reseting the value
                row = row + 1
            Next
        End If
    Next

    getData
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM