Sub GetMarketData()
Dim myBrowser As Object, myHtml As String
Dim htmlTables As Object, htmlTable As Object
Dim htmlRows As Object, htmlRow As Object
Dim htmlCells As Object, htmlCell As Object
Dim xlRow As Long, xlCol As Integer
Dim ExitAt As Date, Symbol As String
Dim Flag As Integer
On Error GoTo ErrHdl
Const myUrl = "http://www.cboe.com/DelayedQuote/QuoteTable.aspx"
Symbol = UCase(Trim(Range("Ticker").Text))
With Range("Ticker").Worksheet
Range(Range("Ticker").Offset(1, 0), Cells(Rows.Count, Range("Ticker").Column + 13)).ClearContents
End With
Set myBrowser = CreateObject("InternetExplorer.Application")
myBrowser.Navigate myUrl
While myBrowser.Busy Or myBrowser.ReadyState <> 4
DoEvents
Wend
With myBrowser.Document.All
On Error Resume Next
ExitAt = Now + TimeValue("00:00:05")
Do
.Item("ctl00_ctl00_AllContent_ContentMain_ucQuoteTableCtl_txtSymbol").Value = Symbol
If Err.Number = 0 Then Exit Do
Err.Clear
DoEvents
If Now > ExitAt Then Exit Do
Loop
.Item("ctl00_ctl00_AllContent_ContentMain_ucQuoteTableCtl_optAll").Checked = True
.Item("ctl00_ctl00_AllContent_ContentMain_ucQuoteTableCtl_btnSubmit").Click
End With
While myBrowser.Busy Or myBrowser.ReadyState <> 4
DoEvents
Wend
ExitAt = Now + TimeValue("00:00:05")
Do
myHtml = myBrowser.Document.body.innerHTML
If InStr(myHtml, "Last Sale") > 0 Then Exit Do
DoEvents
If Now > ExitAt Then Exit Do
Loop
myHtml = myBrowser.Document.body.innerHTML
On Error GoTo ErrHdl
If InStr(myHtml, "Last Sale") = 0
Then Err.Raise vbObjectError + 513, , "No data for '" & Symbol & "'..."
Set htmlTables = myBrowser.Document.All.tags("TABLE")
xlRow = Range("Ticker").Row + 1
For Each htmlTable In htmlTables
If InStr(htmlTable.innerText, Symbol & " (") = 1
Or Flag > 0 Then
Flag = Flag + 1
If Flag <> 2 Then xlRow = xlRow + 1
Set htmlRows = htmlTable.Rows
For Each htmlRow In htmlRows
xlCol = Range("Ticker").Column
Set htmlCells = htmlRow.Cells
For Each htmlCell In htmlCells
Range("Ticker").Worksheet.Cells(xlRow, xlCol) = htmlCell.innerText
xlCol = xlCol + 1
Next htmlCell
If Not
IsEmpty(Range("Ticker").Worksheet.Cells(xlRow, Range("Ticker").Column)) Then xlRow = xlRow + 1
Next htmlRow
End If
If Flag = 3 Then Exit For
Next htmlTable
ErrHdl:
If Err.Number Then
MsgBox Err.Description, vbCritical, "Get Data"
On Error Resume Next
myBrowser.Quit
Set myBrowser = Nothing
Set htmlTables = Nothing
End Sub
CBOE
