Windows API DispCallFunc as function pointer in VBA

This time I wanted to present my solution to one problem, what I have been woodshedding for some time. The beef of this posting is Windows API OLE Automation object function DispCallFunc, which can successfully be used to provide function pointer mechanism in VBA. With this API function (and a couple of additional tricks), we can actually create extremely flexible, extendable and light program designs. At this point, get your coffee ready, because the story is going to be a long one.

SOLVER FOR NON-LINEAR FUNCTIONS

The end result of this post will be a small, flexible and extendable design for a numerical procedure, which solves a root for a given non-linear function. Now, as you already know there are more than a lot of these root-finding algorithms available. In this post, we just use simple Bisection method. We will create a program design, which can be used to solve for option implied volatility or bond yield-to-maturity, for example.

WIN API DISPCALLFUNC FUNCTION

Let us start and go through Windows API function DispCallFunc, which enables us to implement our desired "function-pointer" mechanism. DispCallFunc belongs to a family of Automation objects (OleAut32.dll) which are written in C language. So, we need to be able to handle parameter exchanges between VBA and C interface. There are a lot of articles about this issue to be found in web. One particularly helpful and otherwise extremely comprehensive source for truly advanced VB stuff is a book written by Bruce McKinney called Hardcore Visual Basic. From the previous link, you have an access to online version of this awesome book. The issues concerning VBA/C interfacing are dealt within the chapter 2 (The Second Level of Basic Enlightenment).

Now, to be able to understand how to use DispCallFunc function in practice, let us first quickly go through its arguments. After this we create two simple example programs on the fly.

HRESULT DispCallFunc(
  void *pvInstance,
  ULONG_PTR oVft,
  CALLCONV cc,
  VARTYPE vtReturn,
  UINT cActuals,
  VARTYPE *prgvt,
  VARIANTARG **prgpvarg,
  VARIANT *pvargResult
);

void *pvInstance is a special type of pointer that can be pointed at objects of any data type. However, since we are not dealing with any actual COM objects we can set this value to be 0.

ULONG_PTR oVft is a pointer to unsigned long variable. With this argument we will pass the address of a function. DispCallFunc must have a pointer to the callback function's address in memory. VBA supports the AddressOf operator, which makes it possible to pass the address of a VBA function to a DLL function.

CALLCONV cc is an argument for Calling convention to be used. In general, when we deal with C/C++ DLL functions in VBA, we have to use stdcall convention (4).

VARTYPE vtReturn defines a type for function return value. We will use VbVarType enumerated type that indicates the type of the function's return value. If the function does not return any value (Sub procedure in VBA), we will simply use VbVarType.vbEmpty.

UINT cActuals is an unsigned integer for setting the number of function arguments.

VARTYPE *prgvt is a pointer to an array of Integer type VbVarType enumerated values. DispCallFunc must have information on the type of the function arguments. How do we deal with this one in practice? First, we wrap all function argument variable types into an array one by one by using VarType function. Then, we just pass the address of the first item of array for DLL function. When dealing with arrays from VBA to C/C++ DLL functions, we always pass the first array item, not the whole array. If there is not any function arguments, we can simply use zero value.

VARIANTARG **prgpvarg is a pointer to an array of pointers. First, we need to convert all function arguments into new Variant data types. Then, we wrap the address of each variable into a Long data type array (address is Long data type) by using VarPtr function. Finally, we just pass the address of the first item of array. Again, if there is not any function arguments, we can simply use zero value.

VARIANT *pvargResult is a pointer to variant data type. We need to create a variant type variable and give its address by using VarPtr function again. The result value of a function what DispCallFunc is using, is then stored into this variable. The return value of the actual DispCallFunc is zero (assuming that a function call has been successful).

DispCallFunc - example 1.

First, we create a simple program using DispCallFunc. In this example, function to be called by DispCallFunc does not have any arguments or any return value. DispCallFunc will just call procedure someFunction, which then pops up a message. CopyPaste the following program into a new VBA standard module and run the program.

Option Explicit
'
Private Declare Function DispCallFunc Lib "OleAut32.dll" ( _
    ByVal pvInstance As Long, _
    ByVal oVft As Long, _
    ByVal cc As Long, _
    ByVal vtReturn As Integer, _
    ByVal cActuals As Long, _
    ByVal prgvt As Long, _
    ByVal prgpvarg As Long, _
    ByVal pvargResult As Long _
    ) As Long
    '
Public Sub someFunction()
    MsgBox "DispCallFunc just called me!"
End Sub
'
Public Sub tester()
    '
    Dim DispCallFuncResult As Long
    Dim result As Variant: result = vbEmpty
    DispCallFuncResult = DispCallFunc( _
        0, _
        AddressOf someFunction, _
        CLng(4), _
        VbVarType.vbEmpty, _
        0, _
        0, _
        0, _
        VarPtr(result))
End Sub
'

DispCallFunc - example 2.

Next, our function, which is going to get called by DispCallFunc, has two arguments (double) and a return value (double). CopyPaste the following program into a new VBA standard module and run the program.

Option Explicit
'
Private Declare Function DispCallFunc Lib "OleAut32.dll" ( _
    ByVal pvInstance As Long, _
    ByVal oVft As Long, _
    ByVal cc As Long, _
    ByVal vtReturn As Integer, _
    ByVal cActuals As Long, _
    ByVal prgvt As Long, _
    ByVal prgpvarg As Long, _
    ByVal pvargResult As Long _
    ) As Long
    '
Public Function someFunction(ByVal x As Double, ByVal y As Double) As Double
    someFunction = x * y
End Function
'
Public Sub tester()
    '
    Dim DispCallFuncResult As Long
    Dim result As Variant: result = vbEmpty
    '
    Dim x As Double: x = 1.234
    Dim y As Double: y = 9.876
    '
    Dim vx As Variant: vx = CVar(x)
    Dim vy As Variant: vy = CVar(y)
    '
    Dim varTypes(0 To 1) As Integer
    varTypes(0) = VarType(vx)
    varTypes(1) = VarType(vy)
    '
    Dim varPointers(0 To 1) As Long
    varPointers(0) = VarPtr(vx)
    varPointers(1) = VarPtr(vy)
    '
    DispCallFuncResult = DispCallFunc( _
        0, _
        AddressOf someFunction, _
        CLng(4), _
        VbVarType.vbDouble, _
        2, _
        VarPtr(varTypes(0)), _
        VarPtr(varPointers(0)), _
        VarPtr(result))
    '
    Debug.Print result
End Sub
'

DispCallFunc works as expected and it is enabling "function pointer mechanism" to be used. We should now be ready for implementing DispCallFunc function in our root solver design.


SOLVER DESIGN WITH DISPCALLFUNC

A couple of words about some of the design targets. We would like to be able to

• change our numerical algorithm for root-solving procedure at will.
• change target function (a function which root is going to be solved) used by root solver at will.

Now, when these design targets have been clearly defined, we can start to think about how to accomplish all of this.

To change our numerical algorithm for root-solving procedure at will gives a strong indication for using VB interfaces. In this case, we will create a common IRootSolver interface, from which we can create any desired new root-solving algorithm implementation. 

IRootSolver interface has only one public function (solve), which returns a double and takes in two arguments: "algorithm-related" parameters and "function-related" parameters. In a nutshell, we make a clear division for parameters which are "algorithm-related" and parameters which are "function-related".

When we create our IRootSolver interface and its function signature for this public solve method, we have to make a decision about what are the input arguments for this public solve method. After this, we are married with this function signature, come rain or come shine. Each and every new interface implementation must implement exactly the same interface function signature for this public solve method.

However, each new IRootSolver interface implementation can naturally have different amount of algorithm-related parameters. The most flexible way to have variable amount of input arguments, is to wrap all input parameters into a dictionary data structure. Similarly, target function related parameters are wrapped into a separate data structure. With this approach, public solve method now demands two separate dictionary data structures as its input arguments. One for "algorithm-related" parameters and another for "function-related" parameters. After this, the actual root solver implementation will then "unzip" both data structures to get all the parameters what it needs to perform its numerical procedures. I have been opening this "parameter wrapper" approach in one of my previous posting.
 
But why this kind of solution for feeding parameters? In some other languages you have constructors for all class member variables and those constructors does not need to have any homogenous signatures for arguments. With VBA we do not even have constructors (class initializers are not really constructors, since you can not have any access to class member variables from outside class itself). So, there is a lot of problems coming from the fact, that VBA does not have real constructors. I have been chewing this issue before in this posting under "constructor problem". Anyway, we can find a way out of this irritating problem just by wrapping all possible parameters inside a data structure and then define our public interface function so, that it is taking only data structure as an input argument.

To change target function used in root solver at will is now easy. First of all, the actual public functions are stored separately in a standard VBA module. A target function is one of those "algorithm-related" parameters and we will wrap its address into a Dictionary by using AddressOf function. As soon as any solver implementation will "unzip" the input algorithm-related data structure, it will have an address to our given target function what solver can use in DispCallFunc function. Function address is really all it knows. Now, we can give any function from our "function library" and solver implementation will then be using this given function with DispCallFunc function, assuming of course that we give all the other required parameters for it.

SOLVER DESIGN IMPLEMENTATION

Finally, we will now create a program, which solves zero-coupon bond yield-to-maturity and option implied volatility as an example. For solving a zero-coupon bond yield-to-maturity, there is no need for any numerical procedure since analytical formula exists. However, it is included here only for demonstration purposes.

Open a new Excel for this project and copyPaste all the following program parts and follow all the given instructions. At this point you could reference Microsoft Scripting Runtime library in your VB editor (Tools - References - Microsoft Scripting Runtime), since we are using Dictionary data structure in our program.

Function library (New standard VBA module, name=FuncLib)

Option Explicit
'
' zero-coupon bond price
Public Function ZCB_price( _
    ByVal n As Double, _
    ByVal y As Double, _
    ByVal t As Double _
) As Double
    '
    ZCB_price = n * Exp(-y * t)
End Function
'
' plain vanilla call option pricing formula
Public Function BS_call( _
    ByVal s As Double, _
    ByVal x As Double, _
    ByVal v As Double, _
    ByVal t As Double, _
    ByVal r As Double _
) As Double
    '
    Dim d1 As Double: d1 = (Log(s / x) + (r + 0.5 * v * v) * t) * (1 / (v * Sqr(t)))
    Dim d2 As Double: d2 = d1 - v * Sqr(t)
    BS_call = s * CND(d1) - x * Exp(-r * t) * CND(d2)
End Function
'
' cumulative normal distribution (Abramowitz and Stegun approximation 1964)
Public Function CND(ByVal z As Double) As Double
    '
    Dim b1 As Double, b2 As Double, b3 As Double, b4 As Double, b5 As Double, p As Double, _
    c2 As Double, a As Double, b As Double, t  As Double, n As Double
    '
    If (z > 6#) Then CND = 1: Exit Function
    If (z < -6#) Then CND = 0#: Exit Function
    '
    b1 = 0.31938153: b2 = -0.356563782
    b3 = 1.781477937: b4 = -1.821255978
    b5 = 1.330274429: p = 0.2316419
    c2 = 0.3989423: a = Abs(z)
    t = 1# / (1# + a * p)
    b = c2 * Exp((-z) * (z / 2#))
    n = ((((b5 * t + b4) * t + b3) * t + b2) * t + b1) * t
    n = 1# - b * n
    If (z < 0#) Then n = 1# - n
    CND = n
End Function
'

IRootSolver interface  (New VBA class module, name=IRootSolver)

Option Explicit
'
Public Function solve( _
    ByRef algorithmParameters As Scripting.Dictionary, _
    ByRef targetFunctionParameters As Scripting.Dictionary _
    ) As Double
    '
    ' interface - no implementation
End Function
'

IRootSolver implementation  (New VBA class module, name=BisectionAlgorithm)

Option Explicit
'
Implements IRootSolver
'
' Win API function declaration for DispCallFunc
' http://msdn.microsoft.com/en-us/library/windows/desktop/ms221473(v=vs.85).aspx
Private Declare Function DispCallFunc Lib "OleAut32.dll" _
(ByVal pvInstance As Long, ByVal oVft As Long, ByVal cc As Long, ByVal vtReturn As Long, _
ByVal cActuals As Long, ByVal prgvt As Long, ByVal prgpvarg As Long, ByVal pvargResult As Long) As Long
'
Private Function IRootSolver_solve( _
    ByRef algorithmParameters As Scripting.Dictionary, _
    ByRef targetFunctionParameters As Scripting.Dictionary _
    ) As Double
    '
    ' extract all algorithm-related parameters for this particular implementation
    Dim f As Long
    f = algorithmParameters(E_TARGET_FUNCTION_ADDRESS)
    '
    Dim targetValue As Double
    targetValue = algorithmParameters(E_TARGET_FUNCTION_TARGET_VALUE)
    '
    Dim targetParameterNumber As Integer
    targetParameterNumber = (algorithmParameters(E_TARGET_FUNCTION_TARGET_PARAMETER_NUMBER) - 1)
    '
    Dim iterations As Long
    iterations = algorithmParameters(E_MAX_ITERATIONS)
    '
    Dim tolerance As Double
    tolerance = algorithmParameters(E_TOLERANCE)
    '
    Dim low As Double: low = algorithmParameters(E_LOW)
    Dim high As Double: high = algorithmParameters(E_HIGH)
    '
    ' create data/data structures for Win API
    Dim IDispCallFuncResult As Long
    Dim result As Variant: result = vbEmpty
    Dim varTypes() As Integer: ReDim varTypes(0 To targetFunctionParameters.Count - 1)
    Dim varPointers() As Long: ReDim varPointers(0 To targetFunctionParameters.Count - 1)
    '
    ' iterate to solve for root
    Dim root As Double: root = (high + low) * 0.5
    Dim counter As Long
    For counter = 1 To iterations
        '
        ' set parameters for Win API
        ' extract function-related parameters
        Dim i As Integer
        For i = 0 To targetFunctionParameters.Count - 1
            '
            ' use root estimate for targetParameterNumber
            If (i = targetParameterNumber) Then
                varTypes(i) = VarType(CVar(root))
                varPointers(i) = VarPtr(CVar(root))
            Else
                varTypes(i) = VarType(CVar(targetFunctionParameters.Items(i)))
                varPointers(i) = VarPtr(CVar(targetFunctionParameters.Items(i)))
            End If
        Next i
        '
        ' use DispCallFunc as "function pointer"
        IDispCallFuncResult = DispCallFunc( _
            0, _
            f, _
            CLng(4), _
            VbVarType.vbDouble, _
            targetFunctionParameters.Count, _
            VarPtr(varTypes(0)), _
            VarPtr(varPointers(0)), _
            VarPtr(result) _
        )
        '
        ' use result from DispCallFunc to adjust root estimate
        Dim difference As Double: difference = (result - targetValue)
        If (Abs(difference) <= tolerance) Then Exit For
        '
        If (difference < 0) Then
            high = high
            low = root
        Else
            high = root
            low = low
        End If
        '
        root = (high + low) * 0.5
    Next counter
    '
    ' return root estimate
    IRootSolver_solve = root
End Function
'

Enumerators for parameter wrappers  (New standard VBA module, name=Enumerators)

Option Explicit
'
Public Enum ENUM_PARAMETERS
    '
    E_TARGET_FUNCTION_ADDRESS = 1
    E_TARGET_FUNCTION_TARGET_VALUE = 2
    E_TARGET_FUNCTION_TARGET_PARAMETER_NUMBER = 3
    E_MAX_ITERATIONS = 4
    E_TOLERANCE = 5
    E_LOW = 6
    E_HIGH = 7
    '
    E_SPOT = 8
    E_STRIKE = 9
    E_TIME = 10
    E_RATE = 11
    E_IMPLIED_VOLATILITY = 12
    E_FACE_VALUE = 13
    E_YIELD = 14
End Enum
'

Main program  (New standard VBA module, name=MainProgram)

Option Explicit
'
Public Sub tester()
    '
    ' create rootSolver and wrappers for parameters
    Dim rSolver As IRootSolver: Set rSolver = New BisectionAlgorithm
    Dim algorithmParameters As Scripting.Dictionary
    Dim targetFunctionParameters As Scripting.Dictionary
    '
    '
    ' A. SOLVE FOR ZERO-COUPON BOND YIELD
    ' wrap all algorithm-related parameters
    Set algorithmParameters = New Scripting.Dictionary
    algorithmParameters.Add E_TARGET_FUNCTION_ADDRESS, AddressOf FuncLib.ZCB_price
    algorithmParameters.Add E_TARGET_FUNCTION_TARGET_VALUE, CDbl(94.01252)
    ' corresponds to E_YIELD
    algorithmParameters.Add E_TARGET_FUNCTION_TARGET_PARAMETER_NUMBER, CInt(2)
    algorithmParameters.Add E_MAX_ITERATIONS, CLng(1000)
    algorithmParameters.Add E_TOLERANCE, CDbl(0.00001)
    algorithmParameters.Add E_LOW, CDbl(1)
    algorithmParameters.Add E_HIGH, CDbl(0)
    '
    ' wrap all target-function-related parameters
    Set targetFunctionParameters = New Scripting.Dictionary
    targetFunctionParameters.Add E_FACE_VALUE, CDbl(100)
    ' parameter is given as empty value
    targetFunctionParameters.Add E_YIELD, CDbl(0)
    targetFunctionParameters.Add E_TIME, CDbl(2.487)
    '
    Dim bondYield As Double
    bondYield = rSolver.solve(algorithmParameters, targetFunctionParameters)
    '
    Debug.Print bondYield
    Set algorithmParameters = Nothing
    Set targetFunctionParameters = Nothing
    '
    '
    ' B. SOLVE FOR IMPLIED VOLATILITY
    ' wrap all algorithm-related parameters
    Set algorithmParameters = New Scripting.Dictionary
    algorithmParameters.Add E_TARGET_FUNCTION_ADDRESS, AddressOf FuncLib.BS_call
    algorithmParameters.Add E_TARGET_FUNCTION_TARGET_VALUE, CDbl(10.985)
    ' corresponds to E_IMPLIED_VOLATILITY
    algorithmParameters.Add E_TARGET_FUNCTION_TARGET_PARAMETER_NUMBER, CInt(3)
    algorithmParameters.Add E_MAX_ITERATIONS, CLng(1000)
    algorithmParameters.Add E_TOLERANCE, CDbl(0.00001)
    algorithmParameters.Add E_LOW, CDbl(0)
    algorithmParameters.Add E_HIGH, CDbl(1)
    '
    ' wrap all target-function-related parameters
    Set targetFunctionParameters = New Scripting.Dictionary
    targetFunctionParameters.Add E_SPOT, CDbl(101.25)
    targetFunctionParameters.Add E_STRIKE, CDbl(100)
    ' parameter is given as empty value
    targetFunctionParameters.Add E_IMPLIED_VOLATILITY, CDbl(0)
    targetFunctionParameters.Add E_TIME, CDbl(1.25)
    targetFunctionParameters.Add E_RATE, CDbl(0.0215)
    '
    Dim impliedVolatility As Double
    impliedVolatility = rSolver.solve(algorithmParameters, targetFunctionParameters)
    '
    Debug.Print impliedVolatility
    Set algorithmParameters = Nothing
    Set targetFunctionParameters = Nothing
    Set rSolver = Nothing
End Sub
'

Note, that the order of parameters inside data structure (target function-related parameters) must correspond exactly the order of target function arguments found in the actual function signature (found in our function library module). Also, the variable what we are about to solve (implied volatility, yield) is also given in function-related parameter wrapper but with zero value. Then, in algorithm-related parameter wrapper we have information, what is the order of item in function-related wrapper, which is going to be solved. 


PROS, CONS AND AFTERTHOUGHTS

DispCallFunc works as desired and it can enable cool callback mechanism to be used in VBA. With this design we can implement any new numerical algorithm from our generic IRootSolver. No matter what are the input arguments or how many input arguments there will be for any new solver implementation. We can always zip these input parameters inside a wrapper. In this way, we obey the requirement for "homogeneous public interface function signature" for any new IRootSolver interface implementation. Moreover, we can use any auxiliary function to be solved, since we are delivering the address of this auxiliary function to solver as one of its input parameters.

Of course we need to admit, that compared with the corresponding C/C# mechanism, there are "some additional twists" included, but nothing really too complicated or unmanageable.

Well, that's all for now. If you have been missing some proper callback mechanisms for your VBA programs, you might take a look at this DispCallFunc stuff. This time I need to give my deepest appreciations for Akihito Yamashiro, who has wonderfully and thoroughly opened this issue in his blog.

It has really been a while since my last posting. I have been more than busy with so many issues going on. Being otherwise "A Hard Working Family Man" these days, I additionally decided to go through Certificate in Quantitative Finance program, what I have been quietly woodshedding on my own for the last 6 months or so. During the program I have been learning a lot of interesting stuff and hopefully I could be able to share some of those things with you as well. After finishing CQF, I should be able to allocate some time again for this blog.

Thanks for reading, see you again and have a nice weekend!
-Mike

Bloomberg V3COM API wrapper update 2 for VBA

I am finally publishing some updates (hopefully also improvements) to the existing version for Bloomberg BCOM wrapper. If you are not familiar with the previous versions, you might want to take a look at these first.

http://mikejuniperhill.blogspot.fi/2013/05/bloomberg-v3com-api-wrapper-for-vba.html

http://mikejuniperhill.blogspot.fi/2013/06/bloomberg-v3com-api-wrapper-update-for.html

Three interface functions

With this updated version, I have now decided to break the class public interface function (previously getData function) into three separate functions. Handling all those different mandatory/optional input parameters for all different types of market data started to be a bit too messy operation to handle and public interface function mutated itself into a scary-looking monster. However, I still have not compromised the basic principle which says, that the wrapper is a compact one-module entity, which can be imported easily into your new VBA project. So, everything is (and hopefully will be) inside one class module. Anyway, to be more specific about the new public function interfaces, we have now three separate public functions for different types of data queries:

1. referenceData
2. bulkReferenceData
3. historicalData

I assume that you are familiar of these data query types already. If not, then read those previous posts. Now, let us investigate these function interfaces a bit to be able to understand, what has been changed.

For referenceData, the new class interface function has been defined to be the following:

Public Function referenceData(ByRef securities As Variant, _
    ByRef fields As Variant, _
    Optional ByRef overrideFields As Variant, _
    Optional ByRef overrideValues As Variant) As Variant

Needless to say, we still need to give arrays for securities (Bloomberg tickers with yellow key) and fields (Bloomberg field names).

Field override in Bloomberg

What is new here, is the override optionality. To implement an override to any field, we need to set up one array for override field names and another for override values. Excellent source for investigating possible override options for a field, is Bloomberg itself and its FLDS function. For example, you can test the override in your Bloomberg with the following commands:

IBM US Equity <GO>
FLDS <GO> 
write best eps into FLDS query input box and press ENTER
mouse-click BEST_EPS

You should now have a view for all the fields, which can be overriden for this specific field (BEST_EPS). Just for an example, if you select BEST_FPERIOD_OVERRIDE (default value = 1FY) to be 3FY, you can see that the value for BEST_EPS also changes. And so on. If you play with this FLDS for a while, you should become pretty comfortable with this override possibility in Bloomberg. Personally I have to give a credit for Bloomy people for giving out this function, since it is a really great tool, which truly increases your productivity. There is an example tester program given for reference data retrieving in the code section below, with and without override. If you already did not know, you can retrieve multiple fields for multiple securities, as that example program shows. 

Next, we have bulkReferenceData. The new class public interface function has been defined to be the following:

Public Function bulkReferenceData(ByRef securities As Variant, _
    ByRef fields As Variant, _
    Optional ByRef overrideFields As Variant, _
    Optional ByRef overrideValues As Variant) As Variant

Nothing else has been changed, except we have now override possibility also for this type of data retrieving. Using override follows exactly, what has been presented above for reference data. I guess that most of the people will retrieve option chains, bond chains or curve member chains from Bloomberg. If you are not familiar what kind of overrides you can have for a chain, use FLDS again (BOND_CHAIN, OPT_CHAIN, INDX_MEMBERS). There is an example tester program given for bulk reference data retrieving in the code section below, with and without override. It should be noted also, that you can also retrieve chains for multiple securities, as that example program shows. Because the function returns a multidimensional array, there might be some further labour needed for handling this array for empty items. However, if you are comfortable enough with VBA arrays, this should not be any tombstone for your project.

Finally, we have the trickiest one, historicalData. Function interface has been defined to be the following:

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

Note the large amount of optional parameters for historical data. If you are familiar with Bloomberg BDH function, you may notice, that these optional parameters above are exactly the same what are being used in that BDH function. Let us go through the optional parameters:

• calendarCodeOverride - Returns the data based on the calendar of the specified country, exchange or religion from CDR <GO>. Taking a two character calendar code null terminated string. This will cause the data to be aligned according to the calendar and including calendar holidays. This only applies to daily requests.
• currencyCode - Amends the value from local currency of the security to the desired currency. Currency of the ISO code. Eg. USD, GBP.
• nonTradingDayFillOption - Sets whether to include or exclude Non-Trading Days when no data is available. NON_TRADING_WEEKDAYS, ALL_CALENDAR_DAYS or ACTIVE_DAYS_ONLY (default).
• nonTradingDayFillMethod - Formats the type of data returned for non-trading days. PREVIOUS_VALUE (default) or NIL_VALUE.
• periodicityAdjustment - Sets the periodicity of the data. ACTUAL, CALENDAR (default) or FISCAL.
• periodicitySelection - DAILY (default), WEEKLY, MONTHLY, QUARTERLY, SEMI_ANNUALLY or YEARLY.
• maxDataPoints - The number of periods to download from the end date.  The response will contain up to X data points, where X is the integer specified. If the original data set is larger than X, the response will be a subset, containing the last X data points. Hence the first range of data points will be removed. Any positive integer.
• pricingOption - Sets quote to Price or Yield for a debt instrument. PRICING_OPTION_PRICE or PRICING_OPTION_YIELD (default for debt instrument).

These definitions for optional parameters given above, are copy-pasted from Bloomberg WAPI site. The best way to learn what kind of effect these parameters has on your result data, is just to play with parameters. There are also some override possibilities for historical data request and these are following the same principles as presented within the previous sections. If you want to know what kind of fields can be overriden for historical data retrieving, consult WAPI<GO> or contact Bloomberg help desk. To be honest, I am not so familiar with overriding fields for historical data.

Data array inconsistency for historical data - the problem

With this updated version for historical data, it is now possible to retrieve historical data also for multiple fields and multiple securities. However, one really annoying feature for this historical data retrieving for multiple securities is the fact, that the dates for different securities are not necessarily matching inside arrays. I mean, that for an array item n

• security A has a date of 12.8.2013 for the item
• security B has a date of 15.8.2013 for the item
• security C has a date of 13.8.2013 for the item 

Technically speaking, you could do a separate function for handling this problem. First you get raw data for all n securities. After this, you pick up one security to be "reference security" for dates. Then you loop through the whole data set (n-1 securities left) and fetch data for "reference security dates" for all those securities left. Then you also need to define a rule for missing data. For example, use previous value if security does not have observation for a give date, and so on. So, even it should not be "intellectually too challenging", for sure it means a lot of extra churning with your code. So, what to do? 

The solution

Because of all those ingenious optional parameters implemented, there is an elegant way to overcome this problem. We give the following optional parameters for wrapper when retrieving historical data

• nonTradingDayFillOption = ALL_CALENDAR_DAYS
• nonTradingDayFillMethod = PREVIOUS_VALUE.

There is an example tester program for retrieving historical data with these optional parameters implemented. It shows that by employing this method, your data arrays for different securities will be "date consistent" with each other. Make sure, that you have "Sheet1" existing in your Excel, since all tester programs are printing out the result data into this worksheet. Final note: do not forget to declare Bloomberg V3COM API library: VBA editor (ALT+F11) - Tools - References -  Bloomberg API COM 3.x Type Library.

Afterthoughts

The biggest improvement for this version has been the optionality for field value overrides. Second improvement has been the possibility for retrieving data for multiple securities (bulk reference and historical data) and multiple fields (historical data). I have tested example programs and they should be working correctly. If you observe anything unusual going on with wrapper, just leave a comment for me.

My personal Thank You this time goes to Faizal from Singapore. As I have been gradually working with this wrapper, he has been giving me 1) some proper motivation to work, 2) valuable suggestions and comments, and 3) extremely valuable help for testing this wrapper with real-life data sets.

Anyway, have a great start for autumn and thanks for reading my blog. I hope you got something to make your life a bit easier when working with Bloomberg market data in VBA.

-Mike

' 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 Class module, 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
'