Send input to a web and read data from the web to Excel using VBA

[Gwinn]

Hey guys,

I need to get data from a website. The problem is, the data is generated for each day, based on user input.

So I need a macro, which will access the website, input the date and read the resulting data into Excel.

The web I need the data from is PZU: Raport PIP si Volum Tranzactionat

There, I need to change the date, hit submit and then read the two tables with market prices into excel.

Any help would be most welcome

PS: I am fairly familiar with VBA, so the only part I really need help with is getting the data from the webpage. Once it is in excel, I can manipulate it into any format I need myself. The part that loops through multiple dates is also easy.

 

[pplstuff]

I can't help exactly, but maybe this might spark some ideas?

Start by recording a macro.
Data tab - > Get external data group - > from web

Here, you'll paste in the website URL and select which data fields you want. Stop the macro record and use that as a starting point.

I've done something recently where I used for loops to input dates into the URL, and it would hit that page, pull the fields, then hit the next date page and so one. But this only worked for me because the URL was exactly the same (with the exception of mm/dd/yyyy).

I'm not sure how to INPUT excel data into a web field. Hopes this helps or sparks ideas.

 

[Kyle123]

Like this:

Sub test()
    Dim coll As Collection
    
    Set coll = GetTables(#2012-11-09#)
    
    Sheets(1).Cells(1, 1).Resize(UBound(coll("Table1")), UBound(coll("Table1"), 2)).Value = coll("Table1")
    Sheets(2).Cells(1, 1).Resize(UBound(coll("Table2")), UBound(coll("Table2"), 2)).Value = coll("Table2")
End Sub


Public Function GetTables(dDate As Date) As Collection


    Dim coll    As Collection
    Dim oHtm    As Object
    Dim tab1()  As Variant
    Dim tab2()  As Variant
    Dim x       As Long
    Dim y       As Long
    
    Set coll = New Collection
    
    Set oHtm = CreateObject("htmlfile")
    
    With CreateObject("msxml2.xmlhttp")
        .Open "POST", "http://www.opcom.ro/rapoarte/raportPIPsiVolumTranzactionat.php?lang=ro", False
        .setrequestheader "Content-Type", "application/x-www-form-urlencoded"
        .send "day=" & Day(dDate) & _
                "&month=" & Month(dDate) & _
                "&year=" & Year(dDate) & _
                "&buton=Refresh"
        oHtm.body.innerhtml = .responsetext
    End With
    
    With oHtm.getelementsbytagname("table")(2)
        ReDim tab1(1 To .Rows.Length, 1 To .Rows(1).Cells.Length)
        For x = 1 To .Rows.Length
            For y = 1 To .Rows(x - 1).Cells.Length
                tab1(x, y) = .Rows(x - 1).Cells(y - 1).innertext
            Next y
        Next x
        coll.Add tab1, "Table1"
    End With
    
    With oHtm.getelementsbytagname("table")(3)
        ReDim tab2(1 To .Rows.Length, 1 To .Rows(1).Cells.Length)
        For x = 1 To .Rows.Length
            For y = 1 To .Rows(x - 1).Cells.Length
                tab2(x, y) = .Rows(x - 1).Cells(y - 1).innertext
            Next y
        Next x
        coll.Add tab2, "Table2"
    End With
    
    Set GetTables = coll


End Function

 

[Gwinn]

Like this:

Sub test()
    Dim coll As Collection
    
    Set coll = GetTables(#2012-11-09#)
    
    Sheets(1).Cells(1, 1).Resize(UBound(coll("Table1")), UBound(coll("Table1"), 2)).Value = coll("Table1")
    Sheets(2).Cells(1, 1).Resize(UBound(coll("Table2")), UBound(coll("Table2"), 2)).Value = coll("Table2")
End Sub


Public Function GetTables(dDate As Date) As Collection


    Dim coll    As Collection
    Dim oHtm    As Object
    Dim tab1()  As Variant
    Dim tab2()  As Variant
    Dim x       As Long
    Dim y       As Long
    
    Set coll = New Collection
    
    Set oHtm = CreateObject("htmlfile")
    
    With CreateObject("msxml2.xmlhttp")
        .Open "POST", "http://www.opcom.ro/rapoarte/raportPIPsiVolumTranzactionat.php?lang=ro", False
        .setrequestheader "Content-Type", "application/x-www-form-urlencoded"
        .send "day=" & Day(dDate) & _
                "&month=" & Month(dDate) & _
                "&year=" & Year(dDate) & _
                "&buton=Refresh"
        oHtm.body.innerhtml = .responsetext
    End With
    
    With oHtm.getelementsbytagname("table")(2)
        ReDim tab1(1 To .Rows.Length, 1 To .Rows(1).Cells.Length)
        For x = 1 To .Rows.Length
            For y = 1 To .Rows(x - 1).Cells.Length
                tab1(x, y) = .Rows(x - 1).Cells(y - 1).innertext
            Next y
        Next x
        coll.Add tab1, "Table1"
    End With
    
    With oHtm.getelementsbytagname("table")(3)
        ReDim tab2(1 To .Rows.Length, 1 To .Rows(1).Cells.Length)
        For x = 1 To .Rows.Length
            For y = 1 To .Rows(x - 1).Cells.Length
                tab2(x, y) = .Rows(x - 1).Cells(y - 1).innertext
            Next y
        Next x
        coll.Add tab2, "Table2"
    End With
    
    Set GetTables = coll


End Function

Wow, that was realy fast and work great. Now off to understanding all of the code Thank you a lot.

 

[Kyle123]

No problem