Import web data in excel using VBA

Question

I want to import MutualFundsPortfolioValues to Excel. I don\'t know how to import data from a web site which I need to do is import web data to Excel within 2 different date

Answer 1

Here is the code to import data using IE Automation.

Input Parameters (Enter in Sheet1 as per screenshot below)
start date = B3
end date = B4
Şirketler = B5 (It allows multiples values which should appear below B5 and so on)

ViewSource of page input fileds

How code works :

• The code creates object of Internet Explorer and navigates to site
• Waits till the page is completely loaded and ready. (IE.readystate)
• Creates the object html class
• Enter the values for the input fields from Sheet1 (txtDateBegin,txtDateEnd , lstCompany)
• Clicks on the submit button
• Iterates thru each row of table dgFunds and dumps into excel Sheet2

Code:

   Dim IE As Object
Sub Website()


    Dim Doc As Object, lastRow As Long, tblTR As Object
    Set IE = CreateObject("internetexplorer.application")
    IE.Visible = True

navigate:
    IE.navigate "http://www.spk.gov.tr/apps/MutualFundsPortfolioValues/FundsInfosFP.aspx?ctype=E&submenuheader=0"

    Do While IE.readystate <> 4: DoEvents: Loop

    Set Doc = CreateObject("htmlfile")
    Set Doc = IE.document

    If Doc Is Nothing Then GoTo navigate

    Set txtDtBegin = Doc.getelementbyid("txtDateBegin")
    txtDtBegin.Value = Format(Sheet1.Range("B3").Value, "dd.MM.yyyy")

    Set txtDtEnd = Doc.getelementbyid("txtDateEnd")
    txtDtEnd.Value = Format(Sheet1.Range("B4").Value, "dd.MM.yyyy")


    lastRow = Sheet1.Range("B65000").End(xlUp).row
    If lastRow < 5 Then Exit Sub

    For i = 5 To lastRow

        Set company = Doc.getelementbyid("lstCompany")
        For x = 0 To company.Options.Length - 1
            If company.Options(x).Text = Sheet1.Range("B" & i) Then
                company.selectedIndex = x

                Set btnCompanyAdd = Doc.getelementbyid("btnCompanyAdd")
                btnCompanyAdd.Click
                Set btnCompanyAdd = Nothing

                wait
                Exit For
            End If
        Next
    Next


    wait

    Set btnSubmit = Doc.getelementbyid("btnSubmit")
    btnSubmit.Click

    wait

    Set tbldgFunds = Doc.getelementbyid("dgFunds")
    Set tblTR = tbldgFunds.getelementsbytagname("tr")



    Dim row As Long, col As Long
    row = 1
    col = 1

    On Error Resume Next

    For Each r In tblTR

        If row = 1 Then
            For Each cell In r.getelementsbytagname("th")
                Sheet2.Cells(row, col) = cell.innerText
                col = col + 1
            Next
            row = row + 1
            col = 1
        Else
            For Each cell In r.getelementsbytagname("td")
                Sheet2.Cells(row, col) = cell.innerText
                col = col + 1
            Next
            row = row + 1
            col = 1
        End If
    Next

    IE.Quit
    Set IE = Nothing

    MsgBox "Done"

End Sub

Sub wait()
    Application.wait Now + TimeSerial(0, 0, 10)
    Do While IE.readystate <> 4: DoEvents: Loop
End Sub

Ouput table in Sheet 2

HTH