Sub GetOptionsData()
Dim i As Long, j As Long, nTotCount As Long, iMax As Long, nCnt As Long, vChainResult As Variant
Dim objBloomberg As BlpData, strSec() As String
Const
offset As Integer
= 10
Dim vArrayFields(1 To 11) As String
vArrayFields(1) = "OPT_EXPIRE_DT"
vArrayFields(2) = "OPT_STRIKE_PX"
vArrayFields(3) = "OPT_PUT_CALL"
vArrayFields(4) = "BID"
vArrayFields(5) = "ASK"
vArrayFields(6) = "LAST_TRADE"
vArrayFields(7) = "BID_ASK_TIME"
vArrayFields(8) = "OPT_EXER_TYP"
vArrayFields(9) = "OPT_IMPLIED_VOLATILITY_BID"
vArrayFields(10) = "OPT_IMPLIED_VOLATILITY_ASK"
vArrayFields(11) = "OPT_IMPLIED_VOLATILITY_MID"
Dim pArrayFields(1 To 4) As String
pArrayFields(1) = "PX ASK"
pArrayFields(2) = "PX BID"
pArrayFields(3) = "PX LAST"
pArrayFields(4) = "LOCAL LAST TIME"
On Error GoTo ErrHdl
Ticker = Range("Ticker")
Range("A" & offset & ":AA" &Rows.Count).ClearContents
'Get Option Chain
Application.StatusBar = Ticker & " Subscription Status: Retrieving Option Chain Tickers"
Set objBloomberg = New BlpData
objBloomberg.Subscribe Ticker, 1, "OPT_CHAIN",Results:=vChainResult
If IsArray(vChainResult) Then
iMax = UBound(vChainResult,1)
For i = 0 To iMax
ReDim Preserve strSec(UBound(vChainResult(i, 0), 1) + nTotCount)
For nCnt = 0 To UBound(vChainResult(i, 0), 1)
strSec(nTotCount) = vChainResult(i, 0)(nCnt, 0)
nTotCount = nTotCount + 1
Cells(i + offset, 1) = strSec(i)
Next nCnt
Next i
vChainResult = vbEmpty
'Get data for each option
For i = LBound(strSec) To UBound(strSec)
Cells(i + offset, 1) = strSec(i)
DoEvents
Application.StatusBar = Ticker & " Subscription Status: Retrieving Data for " & strSec(i) & " (" & i & _
" of " & UBound(strSec) - LBound(strSec) & ")"
objBloomberg.Subscribe strSec(i), i + 1, vArrayFields, monitor:=True, Results:=vbData
For j = 1 To UBound(vArrayFields)
Cells(i +offset, j + 1) = vbData(0, j - 1)
Next j
vbData = vbEmpty
Next i
'Get Data for the underlying
objBloomberg.Subscribe Ticker, 1, pArrayFields, monitor:=True, Results:=vbData
Range("Bid") = vbData(0, 0)
Range("Ask") = vbData(0, 1)
Range("Last") = vbData(0, 2)
Range("Local_Time") = vbData(0, 3)
Range("Time") = Now
Else
MsgBox "Could not retrieve data for " & Ticker, vbCritical, "Get Options Data"
End If
ErrHdl:
Set objBloomberg = Nothing
Application.StatusBar = False
If Err.Number Then MsgBox "VBA Error " & Err.Number & ": " & Err.Description, vbCritical, "Get Data"
End Sub