VBA / Bloomberg API,BCOM_wrapper:从批量数据中获取两列

时间:2016-09-23 21:00:46

标签: vba excel-vba bloomberg excel

我正在使用此链接中的代码: http://mikejuniperhill.blogspot.com/2013/08/bloomberg-v3com-api-wrapper-update-2.html

我想从tester_bulkReferenceData返回此类数据:

8/11/2016   2017:Q2
5/11/2016   2017:Q1
2/23/2016   2016:A
2/23/2016   2016:Q4
11/11/2015  2016:Q3
8/12/2015   2016:Q2
5/13/2015   2016:Q1
2/24/2015   2015:A
2/24/2015   2015:Q4

换句话说,两列。在这种情况下,我拉ERN_ANN_DT_AND_PER,我想要关联的yyyy:Q#标签也出来了。

然而,我得到的只是价值观:

8/11/2016
5/11/2016
2/23/2016
2/23/2016
11/11/2015
8/12/2015
5/13/2015
2/24/2015
2/24/2015

我尝试了这个以及许多其他事情:

ReDim s(0 To 0): s(0) = "M US Equity" 
ReDim f(0 To 0): f(0) = "ERN_ANN_DT_AND_PER"
ReDim overrideFields(0 To 1): overrideFields(0) = "EndCol": overrideFields(1) = "StartCol"
ReDim overrideValues(0 To 1): overrideValues(0) = "2": overrideValues(1) = "1"

这可以在Excel中获得我想要的东西,但我需要在VBA中使用它:

=BDS("M US Equity","ERN_ANN_DT_AND_PER","endcol=2")

以下是该网站的代码:

' VBA standard module
Option Explicit
'
Private b As BCOM_wrapper
Private r As Variant
Private s() As String
Private f() As String
Private overrideFields() As String
Private overrideValues() As String
'
Sub tester_referenceData()
    '
    ' create wrapper object
    Set b = New BCOM_wrapper
    '
    ' create 3 securities and 4 fields
    ReDim s(0 To 2): s(0) = "GS US Equity": s(1) = "DBK GR Equity": s(2) = "JPM US Equity"
    ReDim f(0 To 3): f(0) = "SECURITY_NAME": f(1) = "BEST_EPS": f(2) = "BEST_PE_RATIO": f(3) = "BEST_DIV_YLD"
    '
    ' retrieve result from wrapper into array and print
    r = b.referenceData(s, f)
    printReferenceData r
    '
    ' create 1 override for fields
    ReDim overrideFields(0 To 0): overrideFields(0) = "BEST_FPERIOD_OVERRIDE"
    ReDim overrideValues(0 To 0): overrideValues(0) = "3FY"
    '
    ' retrieve result from wrapper into array and print
    r = b.referenceData(s, f, overrideFields, overrideValues)
    printReferenceData r
    '
    ' release wrapper object
    Set b = Nothing
End Sub
'
Sub tester_bulkReferenceData()
    '
    ' create wrapper object
    Set b = New BCOM_wrapper
    '
    ' create 3 securities and 1 fields
    ReDim s(0 To 2): s(0) = "GS US Equity": s(1) = "DBK GR Equity": s(2) = "JPM US Equity"
    ReDim f(0 To 0): f(0) = "BOND_CHAIN"
    '
    ' retrieve result from wrapper into array and print
    r = b.bulkReferenceData(s, f)
    printBulkReferenceData r
    '
    ' create 2 overrides for chain
    ReDim overrideFields(0 To 1): overrideFields(0) = "CHAIN_CURRENCY": overrideFields(1) = "CHAIN_COUPON_TYPE"
    ReDim overrideValues(0 To 1): overrideValues(0) = "JPY": overrideValues(1) = "FLOATING"
    '
    ' retrieve result from wrapper into array and print
    r = b.bulkReferenceData(s, f, overrideFields, overrideValues)
    printBulkReferenceData r
    '
    ' release wrapper object
    Set b = Nothing
End Sub
'
Sub tester_historicalData()
    '
    ' create wrapper object
    Set b = New BCOM_wrapper
    '
    ' create 3 securities and 4 fields
    ReDim s(0 To 2): s(0) = "GS US Equity": s(1) = "DBK GR Equity": s(2) = "JPM US Equity"
    ReDim f(0 To 3): f(0) = "PX_OPEN": f(1) = "PX_LOW": f(2) = "PX_HIGH": f(3) = "PX_LAST"
    '
    ' retrieve result from wrapper into array
    r = b.historicalData(s, f, CDate("21.8.2008"), CDate("21.8.2013"), , , "ALL_CALENDAR_DAYS", "PREVIOUS_VALUE")
    printHistoricalData r
    '
    ' release wrapper object
    Set b = Nothing
End Sub
'
Private Function printReferenceData(ByRef data As Variant)
    '
    Dim rng As Range: Set rng = Sheets("Sheet1").Range("A1")
    rng.CurrentRegion.ClearContents
    Dim i As Long, j As Long
    '
    On Error Resume Next
    For i = 0 To UBound(data, 1)
        For j = 0 To UBound(data, 2)
            rng(i + 1, j + 1) = data(i, j)
        Next j
    Next i
End Function
'
Private Function printBulkReferenceData(ByRef data As Variant)
    '
    Dim rng As Range: Set rng = Sheets("Sheet1").Range("A1")
    rng.CurrentRegion.ClearContents
    Dim i As Long, j As Long
    '
    On Error Resume Next
    For i = 0 To UBound(data, 1)
        For j = 0 To UBound(data, 2)
            rng(j + 1, i + 1) = data(i, j)
        Next j
    Next i
End Function
'
Private Function printHistoricalData(ByRef data As Variant)
    '
    Dim rng As Range: Set rng = Sheets("Sheet1").Range("A1")
    rng.CurrentRegion.ClearContents
    Dim i As Long, j As Long, k As Long: k = 1
    '
    On Error Resume Next
    For i = 0 To UBound(data, 1)
        For j = 0 To UBound(data, 2)
            rng(j + 1, i + k) = data(i, j)(0)
            rng(j + 1, i + k + 1) = data(i, j)(1)
            rng(j + 1, i + k + 2) = data(i, j)(2)
            rng(j + 1, i + k + 3) = data(i, j)(3)
        Next j
        '
        k = k + 3
    Next i
End Function
'

' VBA类模块,name = BCOM_wrapper

Option Explicit
'
' public enumerator for request type
Public Enum ENUM_REQUEST_TYPE
    REFERENCE_DATA = 1
    HISTORICAL_DATA = 2
    BULK_REFERENCE_DATA = 3
End Enum
'
' constants
Private Const CONST_SERVICE_TYPE As String = "//blp/refdata"
Private Const CONST_REQUEST_TYPE_REFERENCE As String = "ReferenceDataRequest"
Private Const CONST_REQUEST_TYPE_BULK_REFERENCE As String = "ReferenceDataRequest"
Private Const CONST_REQUEST_TYPE_HISTORICAL As String = "HistoricalDataRequest"
'
' private data structures
Private bInputSecurityArray() As String
Private bInputFieldArray() As String
Private bOutputArray As Variant
Private bOverrideFieldArray() As String
Private bOverrideValueArray() As String
'
' BCOM objects
Private bSession As blpapicomLib2.session
Private bService As blpapicomLib2.Service
Private bRequest As blpapicomLib2.request
Private bSecurityArray As blpapicomLib2.element
Private bFieldArray As blpapicomLib2.element
Private bEvent As blpapicomLib2.Event
Private bIterator As blpapicomLib2.MessageIterator
Private bIteratorData As blpapicomLib2.Message
Private bSecurities As blpapicomLib2.element
Private bSecurity As blpapicomLib2.element
Private bSecurityName As blpapicomLib2.element
Private bSecurityField As blpapicomLib2.element
Private bFieldValue As blpapicomLib2.element
Private bSequenceNumber As blpapicomLib2.element
Private bFields As blpapicomLib2.element
Private bField As blpapicomLib2.element
Private bDataPoint As blpapicomLib2.element
Private bOverrides As blpapicomLib2.element
Private bOverrideArray() As blpapicomLib2.element
'
' class non-object data members
Private bStartDate As String
Private bEndDate As String
Private bRequestType As ENUM_REQUEST_TYPE
Private nSecurities As Long
Private nSecurity As Long
Private bCalendarCodeOverride As String
Private bCurrencyCode As String
Private bNonTradingDayFillOption As String
Private bNonTradingDayFillMethod As String
Private bPeriodicityAdjustment As String
Private bPeriodicitySelection As String
Private bMaxDataPoints As Integer
Private bPricingOption As String
'
Public Function referenceData(ByRef securities As Variant, _
    ByRef fields As Variant, _
    Optional ByRef overrideFields As Variant, _
    Optional ByRef overrideValues As Variant) As Variant
    '
    ' mandatory user input parameters
    bRequestType = REFERENCE_DATA
    bInputSecurityArray = securities
    bInputFieldArray = fields
    '
    ' field names and values for overrides
    If Not (VBA.IsMissing(overrideFields)) Then bOverrideFieldArray = overrideFields
    If Not (VBA.IsMissing(overrideValues)) Then bOverrideValueArray = overrideValues
    '
    processDataRequest
    referenceData = bOutputArray
End Function
'
Public Function bulkReferenceData(ByRef securities As Variant, _
    ByRef fields As Variant, _
    Optional ByRef overrideFields As Variant, _
    Optional ByRef overrideValues As Variant) As Variant
    '
    ' mandatory user input parameters
    bRequestType = BULK_REFERENCE_DATA
    bInputSecurityArray = securities
    bInputFieldArray = fields
    '
    ' field names and values for overrides
    If Not (VBA.IsMissing(overrideFields)) Then bOverrideFieldArray = overrideFields
    If Not (VBA.IsMissing(overrideValues)) Then bOverrideValueArray = overrideValues
    '
    processDataRequest
    bulkReferenceData = bOutputArray
End Function
'
Public Function historicalData(ByRef securities As Variant, _
    ByRef fields As Variant, _
    ByVal startDate As Date, _
    ByVal endDate As Date, _
    Optional ByVal calendarCodeOverride As String, _
    Optional ByVal currencyCode As String, _
    Optional ByVal nonTradingDayFillOption As String, _
    Optional ByVal nonTradingDayFillMethod As String, _
    Optional ByVal periodicityAdjustment As String, _
    Optional ByVal periodicitySelection As String, _
    Optional ByVal maxDataPoints As Integer, _
    Optional ByVal pricingOption As String, _
    Optional ByRef overrideFields As Variant, _
    Optional ByRef overrideValues As Variant) As Variant
    '
    ' mandatory user input parameters
    bRequestType = HISTORICAL_DATA
    bInputSecurityArray = securities
    bInputFieldArray = fields
    bStartDate = startDate
    bEndDate = endDate
    '
    ' checks and conversions for user-defined dates
    If ((startDate = CDate(0)) Or (endDate = CDate(0))) Then _
        Err.Raise vbObjectError, "Bloomberg API", "Date parameters missing for historical data query"
    '
    If (startDate > endDate) Then _
        Err.Raise vbObjectError, "Bloomberg API", "Incorrect date parameters for historical data query"
    '
    bStartDate = convertDateToBloombergString(startDate)
    bEndDate = convertDateToBloombergString(endDate)
    '
    ' optional user input parameters
    bCalendarCodeOverride = calendarCodeOverride
    bCurrencyCode = currencyCode
    bNonTradingDayFillOption = nonTradingDayFillOption
    bNonTradingDayFillMethod = nonTradingDayFillMethod
    bPeriodicityAdjustment = periodicityAdjustment
    bPeriodicitySelection = periodicitySelection
    bMaxDataPoints = maxDataPoints
    bPricingOption = pricingOption
    '
    ' field names and values for overrides
    If Not (VBA.IsMissing(overrideFields)) Then bOverrideFieldArray = overrideFields
    If Not (VBA.IsMissing(overrideValues)) Then bOverrideValueArray = overrideValues
    '
    processDataRequest
    historicalData = bOutputArray
End Function
'
Private Function processDataRequest()
    '
    openSession
    sendRequest
    catchServerEvent
    releaseObjects
End Function
'
Private Function openSession()
    '
    Set bSession = New blpapicomLib2.session
    bSession.Start
    bSession.OpenService CONST_SERVICE_TYPE
    Set bService = bSession.GetService(CONST_SERVICE_TYPE)
End Function
'
Private Function sendRequest()
    '
    Select Case bRequestType
        Case ENUM_REQUEST_TYPE.HISTORICAL_DATA
            ReDim bOutputArray(0 To UBound(bInputSecurityArray, 1), 0 To 0)
            Set bRequest = bService.CreateRequest(CONST_REQUEST_TYPE_HISTORICAL)
            '
            ' set mandatory user input parameter
            bRequest.Set "startDate", bStartDate
            bRequest.Set "endDate", bEndDate
            '
            ' set optional user input parameter
            If (bNonTradingDayFillOption <> "") Then bRequest.Set "nonTradingDayFillOption", bNonTradingDayFillOption
            If (bNonTradingDayFillMethod <> "") Then bRequest.Set "nonTradingDayFillMethod", bNonTradingDayFillMethod
            If (bPeriodicityAdjustment <> "") Then bRequest.Set "periodicityAdjustment", bPeriodicityAdjustment
            If (bPeriodicitySelection <> "") Then bRequest.Set "periodicitySelection", bPeriodicitySelection
            If (bCalendarCodeOverride <> "") Then bRequest.Set "calendarCodeOverride", bCalendarCodeOverride
            If (bCurrencyCode <> "") Then bRequest.Set "currency", bCurrencyCode
            If (bMaxDataPoints <> 0) Then bRequest.Set "maxDataPoints", bMaxDataPoints
            If (bPricingOption <> "") Then bRequest.Set "pricingOption ", bPricingOption
            '
        Case ENUM_REQUEST_TYPE.REFERENCE_DATA
            Dim nSecurities As Long: nSecurities = UBound(bInputSecurityArray)
            Dim nFields As Long: nFields = UBound(bInputFieldArray)
            ReDim bOutputArray(0 To nSecurities, 0 To nFields)
            Set bRequest = bService.CreateRequest(CONST_REQUEST_TYPE_REFERENCE)
            '
        Case ENUM_REQUEST_TYPE.BULK_REFERENCE_DATA
            ReDim bOutputArray(0 To UBound(bInputSecurityArray, 1), 0 To 0)
            Set bRequest = bService.CreateRequest(CONST_REQUEST_TYPE_BULK_REFERENCE)
            '
    End Select
    '
    Set bSecurityArray = bRequest.GetElement("securities")
    Set bFieldArray = bRequest.GetElement("fields")
    appendRequestItems
    setOverrides
    bSession.sendRequest bRequest
End Function
'
Private Function setOverrides()
    '
    On Error GoTo errorHandler
    '
    If (UBound(bOverrideFieldArray) <> UBound(bOverrideValueArray)) Then Exit Function
    Set bOverrides = bRequest.GetElement("overrides")
    '
    ReDim bOverrideArray(LBound(bOverrideFieldArray) To UBound(bOverrideFieldArray))
    Dim i As Integer
    For i = 0 To UBound(bOverrideFieldArray)
        '
        If ((Len(bOverrideFieldArray(i)) > 0) And (Len(bOverrideValueArray(i)) > 0)) Then
            '
            Set bOverrideArray(i) = bOverrides.AppendElment()
            bOverrideArray(i).SetElement "fieldId", bOverrideFieldArray(i)
            bOverrideArray(i).SetElement "value", bOverrideValueArray(i)
        End If
    Next i
    Exit Function
    '
errorHandler:
    Exit Function
End Function
'
Private Function appendRequestItems()
    '
    Dim nSecurities As Long: nSecurities = UBound(bInputSecurityArray)
    Dim nFields As Long: nFields = UBound(bInputFieldArray)
    Dim i As Long
    Dim nItems As Integer: nItems = getMax(nSecurities, nFields)
    For i = 0 To nItems
        If (i <= nSecurities) Then bSecurityArray.AppendValue CStr(bInputSecurityArray(i))
        If (i <= nFields) Then bFieldArray.AppendValue CStr(bInputFieldArray(i))
    Next i
End Function
'
Private Function catchServerEvent()
    '
    Dim bExit As Boolean
    Do While (bExit = False)
        Set bEvent = bSession.NextEvent
        If (bEvent.EventType = PARTIAL_RESPONSE Or bEvent.EventType = RESPONSE) Then
            '
            Select Case bRequestType
                Case ENUM_REQUEST_TYPE.REFERENCE_DATA: getServerData_reference
                Case ENUM_REQUEST_TYPE.HISTORICAL_DATA: getServerData_historical
                Case ENUM_REQUEST_TYPE.BULK_REFERENCE_DATA: getServerData_bulkReference
            End Select
            '
            If (bEvent.EventType = RESPONSE) Then bExit = True
        End If
    Loop
End Function
'
Private Function getServerData_reference()
    '
    Set bIterator = bEvent.CreateMessageIterator
    Do While (bIterator.Next)
        Set bIteratorData = bIterator.Message
        Set bSecurities = bIteratorData.GetElement("securityData")
        Dim offsetNumber As Long, i As Long, j As Long
        nSecurities = bSecurities.Count
        '
        For i = 0 To (nSecurities - 1)
            Set bSecurity = bSecurities.GetValue(i)
            Set bSecurityName = bSecurity.GetElement("security")
            Set bSecurityField = bSecurity.GetElement("fieldData")
            Set bSequenceNumber = bSecurity.GetElement("sequenceNumber")
            offsetNumber = CInt(bSequenceNumber.Value)
            '
            For j = 0 To UBound(bInputFieldArray)
                If (bSecurityField.HasElement(bInputFieldArray(j))) Then
                    Set bFieldValue = bSecurityField.GetElement(bInputFieldArray(j))
                    bOutputArray(offsetNumber, j) = bFieldValue.Value
                End If
            Next j
        Next i
    Loop
End Function
'
Private Function getServerData_bulkReference()
    '
    Set bIterator = bEvent.CreateMessageIterator
    nSecurity = nSecurity + 1
    '
    Do While (bIterator.Next)
        Set bIteratorData = bIterator.Message
        Set bSecurities = bIteratorData.GetElement("securityData")
        Dim offsetNumber As Long, i As Long, j As Long
        Dim nSecurities As Long: nSecurities = bSecurities.Count
        '
        Set bSecurity = bSecurities.GetValue(0)
        Set bSecurityField = bSecurity.GetElement("fieldData")
        '
        If (bSecurityField.HasElement(bInputFieldArray(0))) Then
            Set bFieldValue = bSecurityField.GetElement(bInputFieldArray(0))
            '
            If ((bFieldValue.numValues - 1) > UBound(bOutputArray, 2)) Then _
                ReDim Preserve bOutputArray(0 To UBound(bOutputArray, 1), 0 To bFieldValue.numValues - 1)
            '
            For i = 0 To bFieldValue.numValues - 1
                Set bDataPoint = bFieldValue.GetValue(i)
                bOutputArray(nSecurity - 1, i) = bDataPoint.GetElement(0).Value
            Next i
        End If
    Loop
End Function
'
Private Function getServerData_historical()
    '
    Set bIterator = bEvent.CreateMessageIterator
    Do While (bIterator.Next)
        Set bIteratorData = bIterator.Message
        Set bSecurities = bIteratorData.GetElement("securityData")
        Dim nSecurities As Long: nSecurities = bSecurityArray.Count
        Set bSecurityField = bSecurities.GetElement("fieldData")
        Dim nItems As Long, offsetNumber As Long, nFields As Long, i As Long, j As Long
        nItems = bSecurityField.numValues
        If (nItems = 0) Then Exit Function
        If ((nItems > UBound(bOutputArray, 2))) Then _
            ReDim Preserve bOutputArray(0 To nSecurities - 1, 0 To nItems - 1)
        '
        Set bSequenceNumber = bSecurities.GetElement("sequenceNumber")
        offsetNumber = CInt(bSequenceNumber.Value)
        '
        If (bSecurityField.Count > 0) Then
            For i = 0 To (nItems - 1)
                '
                If (bSecurityField.Count > i) Then
                    Set bFields = bSecurityField.GetValue(i)
                    If (bFields.HasElement(bFieldArray(0))) Then
                        '
                        Dim d As Variant: ReDim d(0 To bFields.NumElements - 1)
                        For j = 0 To bFields.NumElements - 1
                            d(j) = bFields.GetElement(j).GetValue(0)
                        Next j
                        '
                        bOutputArray(offsetNumber, i) = d
                    End If
                End If
            Next i
        End If
    Loop
End Function
'
Private Function releaseObjects()
    '
    nSecurity = 0
    Set bDataPoint = Nothing
    Set bFieldValue = Nothing
    Set bSequenceNumber = Nothing
    Set bSecurityField = Nothing
    Set bSecurityName = Nothing
    Set bSecurity = Nothing
    Set bOverrides = Nothing
    Set bSecurities = Nothing
    Set bIteratorData = Nothing
    Set bIterator = Nothing
    Set bEvent = Nothing
    Set bFieldArray = Nothing
    Set bSecurityArray = Nothing
    Set bRequest = Nothing
    Set bService = Nothing
    bSession.Stop
    Set bSession = Nothing
End Function
'
Private Function convertDateToBloombergString(ByVal d As Date) As String
    '
    Dim dayString As String: dayString = VBA.CStr(VBA.Day(d)): If (VBA.Day(d) < 10) Then dayString = "0" + dayString
    Dim MonthString As String: MonthString = VBA.CStr(VBA.Month(d)): If (VBA.Month(d) < 10) Then MonthString = "0" + MonthString
    Dim yearString As String: yearString = VBA.Year(d)
    convertDateToBloombergString = yearString + MonthString + dayString
End Function
'
Private Function getMax(ByVal a As Long, ByVal b As Long) As Long
    '
    getMax = a: If (b > a) Then getMax = b
End Function
'

1 个答案:

答案 0 :(得分:1)

要了解如何访问相关值......

把这些行:

Debug.Print bDataPoint.GetElement(0).Name '<- the name of the item, i.e. Earnings Announcement Date
Debug.Print bDataPoint.GetElement(0).Value '<- the value of the item, i.e. 8/11/2016
Debug.Print bDataPoint.GetElement(1).Name '<- the name of the next item, i.e. Earnings Year and Period
Debug.Print bDataPoint.GetElement(1).Value '<- the value of the next item, i.e. 2017:Q2

在这一行之下:

bOutputArray(nSecurity - 1, i) = bDataPoint.GetElement(0).Value

在:

Private Function getServerData_bulkReference()

编辑:

这不是解决方案,而是使用BCOM_wrapper中的函数说明:

Private Function getServerData_bulkReference()
    '
    Set bIterator = bEvent.CreateMessageIterator
    nSecurity = nSecurity + 1
    '
    Do While (bIterator.Next)
        Set bIteratorData = bIterator.Message
        Set bSecurities = bIteratorData.GetElement("securityData")
        Dim offsetNumber As Long, i As Long, j As Long
        Dim nSecurities As Long: nSecurities = bSecurities.Count
        '
        Set bSecurity = bSecurities.GetValue(0)
        Set bSecurityField = bSecurity.GetElement("fieldData")
        '
        If (bSecurityField.HasElement(bInputFieldArray(0))) Then
            Set bFieldValue = bSecurityField.GetElement(bInputFieldArray(0))
            '
            'If ((bFieldValue.numValues - 1) > UBound(bOutputArray, 2)) Then _
            '    ReDim Preserve bOutputArray(0 To UBound(bOutputArray, 1), 0 To bFieldValue.numValues - 1) 'working 10/24/2016
            '
            For i = 0 To bFieldValue.numValues - 1
                Set bDataPoint = bFieldValue.GetValue(i) 'get val
                Dim numBulkElements As Integer
                numBulkElements = bDataPoint.NumElements
                Dim ind2 As Long
                'bOutputArray(nSecurity - 1, i) = bDataPoint.GetElement(0).Value

                For ind2 = 0 To numBulkElements - 1
                    Dim elem As blpapicomLib2.Element
                    Set elem = bDataPoint.GetElement(ind2)
                    If i = 0 Then
                        Sheet1.Cells(4, ind2 + 5).Value = elem.Name
                    End If
                    Sheet1.Cells(i + 5, ind2 + 5).Value = elem.Value
                    'Sheet1.Cells(i + 5, ind2 + 5).NumberFormat = Sheet1.Range("format_col" & ind2 + 1).Value
                Next ind2
            Next i
        End If
    Loop
End Function