VbaFin.com

Visual Basic for Financial Professionals
   Home      CBOE
In some cases you might want to retrieve data from a web site without knowing the url as it is not displayed in the location box. The example below deals with such scenario by using a few methods of the Internet Explorer class to get the html text, then loads it into Excel to get to the table of interest and finally puts it onto the active spreadsheet.
You need to name Range "Ticker" where to input the stock symbol.

Sub GetMarketData()
 
    Dim myBrowser
As Object, fs As Object, myExcel As Application, xlRange As Range
   
Dim myHtml As String, myFile As String, i As Long, j As Long, Data As Variant
 
    On Error GoTo ErrHdl
    Const myUrl = "http://www.cboe.com/DelayedQuote/QuoteTable.aspx"
  
    Set myBrowser = CreateObject("InternetExplorer.Application")
    myBrowser.Navigate myUrl
    While myBrowser.Busy Or myBrowser.ReadyState <> READYSTATE_COMPLETE
        DoEvents
    Wend
    With myBrowser.Document.All
        On Error Resume Next
        Do
            .Item("ucQuoteTableCtl_txtSymbol").Value = Range("Ticker")
            If Err.Number = 0 Then Exit Do
            Err.Clear
            DoEvents
        Loop
        .Item("ucQuoteTableCtl_optAll").Checked = True
        .Item("ucQuoteTableCtl_btnSubmit").Click
    End With
  
    While myBrowser.Busy Or myBrowser.ReadyState <> READYSTATE_COMPLETE
        DoEvents
    Wend
    myHtml = myBrowser.Document.body.innerHTML
    myBrowser.Quit
    Set fs = CreateObject("Scripting.FileSystemObject")
    myFile = CurDir & "cboequote" & Format(Now, "mmddyyhhmmss") & ".html"
    With fs
        With fs.CreateTextFile(myFile, True, True)
            .Write "<HTML>" & Chr(10) & myHtml & Chr(10) & "</HTML>"
            .Close
        End With
    End With

  
    Set myExcel = New Application
   
With myExcel.Workbooks.Open(myFile, 0, True)
       
Set xlRange = .ActiveSheet.Range("A3:AA1000").Find(What:="Last Sale", MatchCase:=False, _
                              SearchOrder:=xlByColumns, SearchDirection:=xlNext)
        If Not xlRange Is Nothing Then
            myHtml = xlRange.Offset(-2, -1).Address
            myHtml = xlRange.Offset(-2, -1).Value
            myHtml = .ActiveSheet.Range(xlRange.Address).Offset(0, -2)
           
If UCase(Trim(xlRange.Offset(0, -1))) = "PUTS" Then Set xlRange = xlRange.Offset(0, -8)
            Data = .ActiveSheet.Range(xlRange.Offset.End(xlToLeft).Offset(-2, 0), _
                        xlRange.End(xlToRight).End(xlDown).End(xlDown))
            For i = 1 To UBound(Data)
               
For j = 1 To UBound(Data, 2)
                    Cells(i + Range("Ticker").Row + 1, j + Range("Ticker").Column - 1) = Data(i, j)
                Next j
           
Next i
            Range(Cells(i + Range("Ticker").Row + 1, Range("Ticker").Column), Cells(Rows.Count, _
            Range("Ticker").Column + j)).ClearContents
        Else
            MsgBox "Could not find data ...", vbCritical, "Get Data"
        End If
        .Close False
    End With
    myExcel.Quit
    Columns.AutoFit
 
ErrHdl:
    If Err.Number Then MsgBox "VBA Error " & Err.Number & ": " & Err.Description, vbCritical, "Get Data"
    On Error Resume Next
    Set myExcel =
Nothing
    fs.DeleteFile myFile, True
   
Set fs = Nothing
    Set myBrowser = Nothing
  
End Sub