Attribute VB_Name = "COMObjectVirtualMethodTable"
Attribute VB_Description = "\nLast revised 29th May 2019.\n\nThis module is a development on the module developed by user @LaVolpe, for calling methods of COM objects using the virtual method tables (vtables) of the objects. The development particularly adds the ability to call methods that have VARIANT parameters. You should use the CallCOMObjectMethodUsingVtable function to access this functionality. See @LaVolpe's original code at: http://www.vbforums.com/showthread.php?781595-VB6-Call-Functions-By-Pointer-(Universall-DLL-Calls)&p=4794385&viewfull=1#post4794385"

Option Explicit
' Last revised 29th May 2019 (revision date is also above in VB_Description attribute).

' Have tried to follow coding conventions described at
' https://docs.microsoft.com/en-us/dotnet/standard/design-guidelines/general-naming-conventions &
' https://docs.microsoft.com/en-us/dotnet/visual-basic/programming-guide/program-structure/program-structure-and-code-conventions
' that apply to VB.NET & .NET, except when they don't seem sensible or when they do not apply to VBA.
' Couldn't find Microsoft advice for coding conventions to use specifically for VBA.

' Have modified VBA code so that it hopefully also works under VB6 when using a 32-bit environment.

#Const DebuggingMode = True

#If VBA7 Then
    ' See https://docs.microsoft.com/en-us/windows/desktop/api/oleauto/nf-oleauto-dispcallfunc for information on DispCallFunc.

    ' This version of DispCallFunc has arguments accepting pointers to the arrays for the COM method parameters.
    Private Declare PtrSafe Function DispCallFunc1 Lib "oleaut32.dll" _
        Alias "DispCallFunc" (ByVal ptrInstanceOnWhichToRunMethod As LongPtr, _
                              ByVal offsetInVtable As LongPtr, _
                              ByVal callingConvention As CallingConventionCode, _
                              ByVal returnValueType As VBA.VbVarType, _
                              ByVal ParameterCount&, _
                              ByVal ptr1stElementOfParamTypesArray As LongPtr, _
                              ByVal ptr1stElementOfParamPtrsArray As LongPtr, _
                              returnValue) As HRESULT
Attribute DispCallFunc1.VB_Description = "\nSee https://docs.microsoft.com/en-us/windows/desktop/api/oleauto/nf-oleauto-dispcallfunc for information on DispCallFunc. This version of DispCallFunc has arguments accepting pointers to the arrays for the COM method parameters."
        
    ' This version of DispCallFunc has arguments accepting the first elements of the arrays for the COM method parameters. Because they are sent by reference,
    ' DispCallFunc can figure out all the array elements just from the first elements.
    Private Declare PtrSafe Function DispCallFunc2 Lib "oleaut32.dll" _
        Alias "DispCallFunc" (ByVal ptrInstanceOnWhichToRunMethod As LongPtr, _
                              ByVal offsetInVtable As LongPtr, _
                              ByVal callingConvention As CallingConventionCode, _
                              ByVal returnValueType As VBA.VbVarType, _
                              ByVal ParameterCount&, _
                              firstElementOfParamTypesArray%, _
                              firstElementOfParamPtrsArray&, _
                              returnValue) As HRESULT
Attribute DispCallFunc2.VB_Description = "\nSee https://docs.microsoft.com/en-us/windows/desktop/api/oleauto/nf-oleauto-dispcallfunc for information on DispCallFunc. This version of DispCallFunc has arguments accepting the first elements of the arrays for the COM method parameters. Because they are sent by reference, DispCallFunc can figure out all the array elements just from the first elements."
#Else
    ' This branch should be compiled for VB6.
    ' Can currently only handle 32-bit environments if not using VBA7.
    #If Win32 Then
        Private Declare Function DispCallFunc1 Lib "oleaut32.dll" _
            Alias "DispCallFunc" (ByVal ptrInstanceOnWhichToRunMethod As Long, _
                                  ByVal offsetInVtable As Long, _
                                  ByVal callingConvention As CallingConventionCode, _
                                  ByVal returnValueType As VBA.VbVarType, _
                                  ByVal ParameterCount&, _
                                  ByVal ptr1stElementOfParamTypesArray As Long, _
                                  ByVal ptr1stElementOfParamPtrsArray As Long, _
                                  returnValue) As HRESULT
Attribute DispCallFunc1.VB_Description = "\nSee https://docs.microsoft.com/en-us/windows/desktop/api/oleauto/nf-oleauto-dispcallfunc for information on DispCallFunc. This version of DispCallFunc has arguments accepting pointers to the arrays for the COM method parameters."
                                                                
        
        Private Declare Function DispCallFunc2 Lib "oleaut32.dll" _
            Alias "DispCallFunc" (ByVal ptrInstanceOnWhichToRunMethod As Long, _
                                  ByVal offsetInVtable As Long, _
                                  ByVal callingConvention As CallingConventionCode, _
                                  ByVal returnValueType As VBA.VbVarType, _
                                  ByVal ParameterCount&, _
                                  firstElementOfParamTypesArray%, _
                                  firstElementOfParamPointersArray&, _
                                  returnValue) As HRESULT
Attribute DispCallFunc2.VB_Description = "\nSee https://docs.microsoft.com/en-us/windows/desktop/api/oleauto/nf-oleauto-dispcallfunc for information on DispCallFunc. This version of DispCallFunc has arguments accepting the first elements of the arrays for the COM method parameters. Because they are sent by reference, DispCallFunc can figure out all the array elements just from the first elements."
    #End If
#End If
 
' A large list of HRESULT values along with names for the values, is available at: https://www.pinvoke.net/default.aspx/Enums/HRESULT.html .
Private Enum HRESULT
        
    S_OK
    S_FALSE
    
    E_NOTIMPL = &H80004001
    E_NOINTERFACE
    E_POINTER
    E_ABORT
    E_FAIL
        
    E_ACCESSDENIED = &H80070005
    E_HANDLE
    E_UNEXPECTED = &H8000FFFF
    E_OUTOFMEMORY = &H8007000E
    E_INVALIDARG = &H80070057
    
    DISP_E_BADCALLEE = &H80020010
End Enum
 
 
' See 'https://docs.microsoft.com/en-us/dotnet/api/system.runtime.interopservices.comtypes.callconv'
' for more information on this enumeration.
Private Enum CallingConventionCode
    CDeclaration = 1
    Pascal
    MSCPascal = Pascal
    MacPascal
    Standard        ' Typical windows APIs.
    reserved        ' Not used.
    StandardSYSCALL
    MacProgrammersWorkbenchCDecla
    MacProgrammersWorkbenchPascal

End Enum

' Code taken from:
' 'http://www.vbforums.com/showthread.php?857909-AddressOf-for-Class-Methods-(and-other-VTable-exploration)&p=5252853&viewfull=1#post5252853',
' 'http://www.vbforums.com/showthread.php?850313-RESOLVED-DispCallFunc-to-call-COM-Property-Method&p=5191805&viewfull=1#post5191805',
' 'http://www.vbforums.com/showthread.php?781595-VB6-Call-Functions-By-Pointer-(Universall-DLL-Calls)&p=4794387&viewfull=1#post4794387', &
' 'http://www.vbforums.com/showthread.php?781595-VB6-Call-Functions-By-Pointer-(Universall-DLL-Calls)&p=4794385&viewfull=1#post4794385'
' around 25th March 2019 for the following function.
' Credit for re-used code should go to the user @LaVolpe.
'
Public Function CallCOMObjectMethodUsingVtable&(interfaceInstancePointer&, _
                                                vtableOffset&, _
                                                useType2FormOfDispCallFunc As Boolean, _
                                                ByVal whichParametersAreVariants, _
                                                ParamArray methodParameters())
Attribute CallCOMObjectMethodUsingVtable.VB_Description = "\nThis function is used to invoke some method of a COM object using the COM object's virtual method table (vtable), & the DispCallFunc dll function.\n\nParameters:\n    interfaceInstancePointer - a pointer to an interface instance for a COM object.\n    vtableOffset - the zero-bound ordinal offset from the passed interfaceInstancePointer where the virtual function exists (in virtual method table).\n    useType2FormOfDispCallFunc - indicates whether DispCallFunc1 form or DispCallFunc2 form is used for DispCallFunc invocation.\n    whichParametersAreVariants - specifies which parameters in methodParameters need to be of the VARIANT type, as specified by the COM method definition.\n    methodParameters - the values and variant type for each value, corresponding to the method parameters of the method you are calling.\n\nSee code comments for more information on how to use this function."

                                                                   
' Coded to call ActiveX or COM objects, not standard dlls.
  
' Parameters:
'   interfaceInstancePointer.
'       A pointer to an interface instance for a COM object,
'       i.e., ObjPtr(IPicture), ObjPtr(Excel.Application), ObjPtr(new mscorlib.Object).
'       Passing invalid pointers likely to result in crashes.
'   vtableOffset. The zero-bound ordinal offset from the passed
'       interfaceInstancePointer where the virtual function exists.
'       Vtable (virtual method table) offsets for the COM versions of .NET objects can
'               sometimes be obtained using C#. See
'       'https://stackoverflow.com/questions/3504848/access-com-vtable-from-c-sharp'
'       for more information.
'       The 'oleview.exe' tool can be used to get vtable offsets. For example, the
'       property-get method for the Caption property of the Excel.Application object
'       is the 71st method in the oleview.exe-generated TypeLib definition for the
'       _Application interface which in the definition, is listed as inheriting the
'       IDispatch interface. The IDispatch interface (standard COM interface) provides
'       7 methods, so the Caption get method, is the 78th [71+7] vtable method.
'       Because the ordinal number is zero-based, the vtable ordinal number for the
'       method is actually 77.
'       To generate the TypeLib definition for the Excel.Application object using
'       oleview.exe, I simply chose the 'View TypeLib...' menu item from the 'File'
'       menu of the oleview.exe tool, and then when prompted, opened
'       'C:\Program Files (x86)\Microsoft Office\Root\Office16\EXCEL.EXE' on my
'       computer. The oleview.exe tool is available in the Windows SDK & is also
'       provided by Visual Studio.
'   useType2FormOfDispCallFunc. Because I've seen two different ways
'       to invoke DispCallFunc, and because I was having trouble getting
'       DispCallFunc to work, this CallCOMObjectMethodUsingVtable has been written
'       such that the user can choose between 2 ways for invoking DispCallFunc.
'   whichParametersAreVariants. Specifies which parameters in methodParameters
'       need to be of the VARIANT type, as specified by the COM method definition.
'       This argument is needed because variant data cannot be used as sub-type,
'       and so, can't be detected from using the methodParameters alone in
'       its current specification.
'       If none of the parameters have the VARIANT type, you can set this argument
'       to the variant special value Empty to indicate this.
'       If you want to indicate that the 1st & 3rd method parameters are the parameters
'       having the VARIANT type, you can pass the value `Array(1,3)`,
'       `Array(True, False, True)`, or `5` for this argument, to indicate this.
'   methodParameters. The values and variant type for each value, corresponding to the method
'               parameters of the method you are calling. It appears that it is necessary that the
'               last element of methodParameters is a variable pointer to the return variable when
'               vtableOffset refers to a function.
'       Passing incorrect variable types can cause crashes.
'       To ensure you pass the correct variable type, use VB's conversion routines:
'           Passing a Long? CLng(10), CLng(x). Passing an Integer? CInt(10), CInt(x).
'       Special cases:
'           UDTs (structures). Pass these using VarPtr(), i.e., VarPtr(uRect).
'               If UDT members contain static size strings, you should declare those
'               string members as Byte arrays instead. When array is filled-in by the
'               function you called, you can use StrConv() to convert array to string.
'               If UDT members contain dynamic size strings, you should declare those
'               as Long. When the function returns, you can probably use built-in
'               functions provided by @LaVolpe's VB6 code at
'               'http://www.vbforums.com/attachment.php?attachmentid=121317&d=1417193961'
'               to retrieve the string from the pointer provided to your UDT.
'           Arrays. DO NOT pass the array. Pass only a pointer to the first member of
'               the array, i.e., VarPtr(myArray(0)), VarPtr(myArray(0,0)), etc.
'           Strings. My experience is that strings should generally be passed by
'               Pointer [using StrPtr()]. However, if this is not working for you, or
'               you want more information on how strings should be passed, consult
'               @LaVolpe's code.
'           Numeric values vs. variables. Be aware of the variable type of the number
'               you pass. Depending on the value of the number, it may be Integer,
'               Long, Double, etc. Numbers in range -32768 to 32767 are Integer, from
'               -2147483648 to 2147483647 are Long. Fractional/decimal numbers are
'               Double. If function parameter expects Long, don't pass just 5,
'               pass 5& or CLng(5). Numbers as variables. Be sure the variable type
'               matches the parameter type (except for parameters indicated as having
'               the VARIANT type through whichParametersAreVariants),
'               i.e., dont pass variables declared as Variant to a function expecting Long.
'               Note that 'integer' may represent a type different to VBA's integer
'               data type on other platforms & in other programming languages. The
'               types you pass must match the types expected not in name but in
'               specification.
 
' Examples:
'   Call IUnknown::Release
'   (3rd interface method [ordinal #2], no additional parameters):
'       CallCOMObjectMethodUsingVtable interfaceInstancePointer, 2, False, Empty .
'   Call property-get method of Caption property of the _Application interface
'   (78th interface method [ordinal #77],
'     exactly one parameter of type BSTR* [VB's primitive String type can be used]):
'       CallCOMObjectMethodUsingVtable ObjPtr(Excel.Application), _
'                                        77&, False, Empty, VarPtr(OutputString) .

#If VBA7 Then
    Dim ParameterPtrsArray() As LongPtr
#ElseIf Win32 Then
    Dim ParameterPtrsArray() As Long
#Else
    Err.Raise 2051, "CallCOMObjectMethodUsingVtable", _
              "Implementation missing for non-32-bit environments when not running VBA7."
#End If

    Dim DispCallFuncReturnValue As HRESULT, MethodReturnValue As HRESULT
    Dim ParameterCount As Byte
    Dim ParameterTypesArray%()
    Dim CopyOfMethodParameters()
    
    If vtableOffset < 0 Or interfaceInstancePointer = 0 Then
        Err.Raise 2052, "CallCOMObjectMethodUsingVtable", _
                  "`vtableOffset < 0 Or interfaceInstancePointer = 0` is true " & _
                    "when it shouldn't be."
        Exit Function
    End If
    ParameterCount = IIf(IsMissing(methodParameters), 0, UBound(methodParameters) - LBound(methodParameters) + 1)
    
    ReDim ParameterPtrsArray(1 To IIf(ParameterCount = 0, 1, ParameterCount))
    ReDim ParameterTypesArray(1 To IIf(ParameterCount = 0, 1, ParameterCount))
    
    Dim Index As Byte
    For Index = 1 To ParameterCount
        If Index = 1 Then
            ' Copy passed method parameters.
            ' Copying parameters is necessary because otherwise DispCallFunc can
            ' change original arguments that parameters correspond to.
            ' If it is known that DispCallFunc won't change the original arguments,
            ' or if it doesn't matter whether DispCallFunc changes the argument values,
            ' then we can do away with parameter copying (to improve speed.)
            CopyOfMethodParameters() = methodParameters()
            If Not (IsEmpty(whichParametersAreVariants)) Then
                ' Convert if necessary.
                whichParametersAreVariants = AsBooleanArray(whichParametersAreVariants, ParameterCount)
            End If
        End If
        
        ParameterPtrsArray(Index) = VarPtr(CopyOfMethodParameters(Index - 1))
        If IsArray(whichParametersAreVariants) Then
            ParameterTypesArray(Index) = IIf(whichParametersAreVariants(Index), vbVariant, 0)
        End If
        
        If ParameterTypesArray(Index) = 0 Then
            If IsObject(CopyOfMethodParameters(Index - 1)) Then
            ' varType doesn't always return the variable type for objects
            ' which is why we ensure type is vbObject here.
                ParameterTypesArray(Index) = vbObject
            Else
                ParameterTypesArray(Index) = varType(CopyOfMethodParameters(Index - 1))
                ' This Select statement is here just for safety's sake.
                Select Case ParameterTypesArray(Index) - IIf(ParameterTypesArray(Index) >= vbArray, vbArray, 0)
                Case Is < 0, 15, 16, 18, 19, 21 To 35, Is > 36, vbEmpty, vbNull, vbError
                     Select Case ParameterTypesArray(Index)
                     Case vbEmpty, vbNull, vbError
                          ' If these constants are returned not added to vbArray, we don't raise an error.
                     Case Else
                          Err.Raise 2053, "CallCOMObjectMethodUsingVtable", _
                                    "`varType(CopyOfMethodParameters(Index - 1))` has returned an unexpected value. " & _
                                      "It is uncertain whether CallCOMObjectMethodUsingVtable can handle such " & _
                                      "a value." & vbNewLine & _
                                    vbNewLine & _
                                    "varType(CopyOfMethodParameters(Index - 1)) : " & ParameterTypesArray(Index) & vbNewLine & _
                                    "Index - 1 : " & (Index - 1)
                     End Select
                End Select
            End If
        End If
    Next
    
    ' It is assumed that return value of function at vtableOffset
    ' address will be of type HRESULT (vbLong).
    Dim CommonArguments()
    ' Calling VBA.Array() instead of just Array(), should ensure
    ' lower-bound is 0.
    CommonArguments = VBA.Array(interfaceInstancePointer, _
                                vtableOffset * 4&, _
                                CallingConventionCode.Standard, _
                                vbLong, _
                                CLng(ParameterCount))
    If Not (useType2FormOfDispCallFunc) Then
        ' These pointer variables are used for type-1 form of DispCallFunc.
#If VBA7 Then
        Dim ParameterTypesArrayPointer As LongPtr
        Dim ParameterPtrsArrayPointer As LongPtr
#ElseIf Win32 Then
        Dim ParameterTypesArrayPointer As Long
        Dim ParameterPtrsArrayPointer As Long
#Else
        Err.Raise 2054, "CallCOMObjectMethodUsingVtable", _
                  "Implementation missing for non-32-bit environments when not running VBA7."
#End If
        ParameterTypesArrayPointer = VarPtr(ParameterTypesArray(1))
        ParameterPtrsArrayPointer = VarPtr(ParameterPtrsArray(1))
        DispCallFuncReturnValue = DispCallFunc1(CommonArguments(0), _
                                                CommonArguments(1), _
                                                CommonArguments(2), _
                                                CommonArguments(3), _
                                                CommonArguments(4), _
                                                ParameterTypesArrayPointer, _
                                                ParameterPtrsArrayPointer, _
                                                MethodReturnValue)
    Else
        DispCallFuncReturnValue = DispCallFunc2(CommonArguments(0), _
                                                CommonArguments(1), _
                                                CommonArguments(2), _
                                                CommonArguments(3), _
                                                CommonArguments(4), _
                                                ParameterTypesArray(1), _
                                                ParameterPtrsArray(1), _
                                                MethodReturnValue)
    End If
    CallCOMObjectMethodUsingVtable = MethodReturnValue
    With Err
        Select Case S_OK
        Case Is > DispCallFuncReturnValue
             .Clear: .Number = 2101: .Description = "DispCallFunc invocation"
             CallCOMObjectMethodUsingVtable = DispCallFuncReturnValue
        Case Is > MethodReturnValue
             .Clear: .Number = 2102: .Description = "The COM function that DispCallFunc invoked,"
        Case Else
             ' Success.
             Exit Function
        End Select
        ' Error returned.
        .source = .Description & " in CallCOMObjectMethodUsingVtable."
        .Description = .Description & " returned error code #" & ((2 ^ 16 - 1) And CallCOMObjectMethodUsingVtable) & _
                                                ". HRESULT value is : " & CallCOMObjectMethodUsingVtable & "."
    End With
#If DebuggingMode Then
    Debug.Print Err.Description
    HandleReturnValueError CallCOMObjectMethodUsingVtable
#End If
End Function


Private Sub HandleReturnValueError(errorValue As HRESULT)
Attribute HandleReturnValueError.VB_Description = "\nThis sub-routine provides your own way to handle HRESULT error values. See https://en.wikipedia.org/wiki/HRESULT for information on the HRESULT data type."

' This sub-routine provides your own way to handle HRESULT error values.
' See https://en.wikipedia.org/wiki/HRESULT for information on the HRESULT data type.
 
    ' See 'https://channel9.msdn.com/Shows/Inside/HRESULT' for
    ' information on common HRESULT codes.
    Dim DebugPrintOutput As New Dictionary
    With DebugPrintOutput
        ![0] = "Error - HRESULT "
        Select Case errorValue
        Case Is >= S_OK
             ![1] = "Not an error code."
        Case S_FALSE
             ![1] = ![0] & "S_FALSE - Operation successful but returned no results."
        
        Case E_NOTIMPL
             ![1] = ![0] & "E_NOTIMPL - Not implemented."
        Case E_NOINTERFACE
             ![1] = ![0] & "E_NOINTERFACE - No such interface supported."
        Case E_POINTER
             ![1] = ![0] & "E_POINTER - Pointer that is not valid."
        Case E_ABORT
             ![1] = ![0] & "E_ABORT - Operation aborted."
        Case E_FAIL
             ![1] = ![0] & "E_FAIL - Unspecified failure."
        
        
        Case E_ACCESSDENIED
             ![1] = ![0] & "E_ACCESSDENIED - General access denied error."
        Case E_HANDLE
             ![1] = ![0] & "E_HANDLE - Handle that is not valid."
        Case E_UNEXPECTED
             ![1] = ![0] & "E_UNEXPECTED - Unexpected failure."
        Case E_OUTOFMEMORY
             ![1] = ![0] & "E_OUTOFMEMORY - Failed to allocate necessary memory."
        Case E_INVALIDARG
             ![1] = ![0] & "E_INVALIDARG - One or more arguments are not valid."
        
        Case DISP_E_BADCALLEE
             ![1] = ![0] & "DISP_E_BADCALLEE - Invalid callee." & vbNewLine & _
                    ![0] & "- Facility name: FACILITY_DISPATCH." & vbNewLine & _
                    ![0] & "- Facility description: The source of the error code is a COM Dispatch."
        
        Case Else
             ![1] = "Error code not in list of common error codes - unknown error." & vbNewLine & _
                    "Hex(errorValue) : " & Hex(errorValue) & "." & vbNewLine & _
                    "errorValue :" & errorValue & "." & vbNewLine & _
                    "A potentially complete list of HRESULT-code information may be available at: " & _
                        "https://www.pinvoke.net/default.aspx/Enums/HRESULT.html ." & vbNewLine & _
                    "Error Code `(2 ^ 16 - 1) And errorValue` : " & (2 ^ 16 - 1) And errorValue
        End Select
        Debug.Print ![1]
    End With
End Sub


Private Function AsBooleanArray(source, arraySize As Byte)
Attribute AsBooleanArray.VB_Description = "\nThis function is meant to be a versatile & safe function that can be used to convert values of various forms, to a 1-based one dimensional boolean array. It can be used to convert a number to a reversal of its binary representation as a boolean array. It can also be used to convert an array of numbers such that the numbers set elements in a boolean array to 'true', where the numbers correspond to element positions in the array.\n\nParameters:\n    source - source variable to be converted (must be variant array, boolean array, byte, integer or long).\n    arraySize - the number of elements in returned boolean array (must be big enough to accomodate conversion).\n\nReturn Values:\n    Either:\n         - 1-dimensional boolean array with a lower bound of 1 & upper bound of arraySize, that is a conversion of source, OR\n         - Error value indicating error encountered in function.\n\nSee code for more information on how to use this function."
' This function is meant to be a versatile & safe function that can be used to convert values of various forms, to a
' 1-based one dimensional boolean array. It can be used to convert a number to a reversal of its binary representation
' as a boolean array. It can also be used to convert an array of numbers such that the numbers set elements in a boolean
' array to 'true', where the numbers correspond to element positions in the array.
'
' Parameters:
'     source - source variable to be converted (must be variant array, boolean array, byte, integer or long).
'     arraySize - the number of elements in returned boolean array (must be big enough to accomodate conversion).
'
' Return Values:
'     Either:
'          - 1-dimensional boolean array with a lower bound of 1 & upper bound of arraySize, that is a conversion of source, OR
'          - Error value indicating error encountered in function.
'
' See code for more information on how to use this function.

    Dim Index%   ' Variable used whenever indexing variable is needed.
    If IsObject(source) Then
        GoSub ArrayTooBigError: With Err: .Raise .Number, .source, .Description: End With
    ElseIf arraySize <= 0 Then
        GoSub SpecifiedSizeNotValidError: With Err: .Raise .Number, .source, .Description: End With
    End If
    
    Dim TypeOfSource&
    TypeOfSource = varType(source)
    
    Dim sourceAsBooleanArray() As Boolean
    ReDim sourceAsBooleanArray(1 To arraySize)
    
    If IsArray(source) Then
        If DimensionCount(source) <> 1 Then
            GoSub WrongNumberOfDimensionsError: With Err: .Raise .Number, .source, .Description: End With
        End If
        ' Dealing with an array.
        ' Basic validation of array size.
        If UBound(source) - LBound(source) + 1 > arraySize Then
            GoSub ArrayTooBigError: With Err: .Raise .Number, .source, .Description:: End With
        End If
        Select Case TypeOfSource And Not (vbArray)
        ' Array of variant data.
        Case vbVariant
            ' Perform basic validation on variant array & convert to boolean array.
            Dim WhichCategoryForElements As Boolean
            For Index = LBound(source) To UBound(source)
                If IsObject(source(Index)) Then
                    GoSub ElementIsObjectError: With Err: .Raise .Number, .source, .Description: End With
                End If
                Select Case varType(source(Index))
                Case vbBoolean  ' Category 0 element.
                     If Index = LBound(source) Then
                        ' First element.
                        WhichCategoryForElements = 0 ' All elements should be boolean.
                     ElseIf WhichCategoryForElements = CBool(1) Then
                        GoSub ElementCategoryShouldBe1Error: With Err: .Raise .Number, .source, .Description: End With
                     End If
                    sourceAsBooleanArray(Index + 1 - LBound(source)) = source(Index)
                Case vbByte, vbInteger, vbLong  ' Category 1 element.
                     If Index = LBound(source) Then
                        ' First element.
                        WhichCategoryForElements = 1 ' All elements should be byte, integer or long.
                     ElseIf WhichCategoryForElements = CBool(0) Then
                        GoSub ElementShouldBeBooleanError: With Err: .Raise .Number, .source, .Description: End With
                     End If
                     GoSub CommonValidationOnSourceElement:
                     ' Passed validation on element.
                     sourceAsBooleanArray(source(Index)) = True
                    
                Case Else
                     GoSub WrongElementTypeError: With Err: .Raise .Number, .source, .Description: End With
                End Select
            Next
            
        ' Array of non-boolean integral numeric data type.
        Case vbByte, vbInteger, vbLong
             For Index = LBound(source) To UBound(source)
                GoSub CommonValidationOnSourceElement:
                ' Passed validation on element.
                sourceAsBooleanArray(source(Index)) = True
             Next
        Case vbBoolean
             If LBound(source) = 1 And UBound(source) = arraySize Then
                ' No conversion needed.
                AsBooleanArray = source
                Exit Function
             Else
                ' Source array is too small and / or has the wrong lower limit.
                For Index = LBound(source) To UBound(source)
                    sourceAsBooleanArray(Index - LBound(source) + 1) = source(Index)
                Next
             End If
        Case Else
             GoSub WrongArrayTypeError: With Err: .Raise .Number, .source, .Description: End With
        End Select
    Else
        ' Not dealing with an array.
        ' Only conversion method left is binary conversion of number.
        Select Case TypeOfSource
        Case vbByte, vbInteger, vbLong
            
             ' Basic validation.
             If Int(Round(Math.Log(IIf(source = 0, _
                                      1, _
                                      source)) _
                          / _
                          Math.Log(2), _
                         8) _
                   ) + 1 _
                > arraySize _
             Then
                GoSub TooManyBinaryDigitsRequiredError: With Err: .Raise .Number, .source, .Description: End With
             End If
             ' Convert integral number to boolean array. Note that boolean array reverses order of binary digits.
             ' This has been done because without reversal, a number in two different non-boolean integral numeric
                         ' data types sets different array elements to true even when the data types have big enough ranges
                         ' for the value.
             For Index = 1 To arraySize
                sourceAsBooleanArray(Index) = CBool(source And (2 ^ (Index - 1)))
             Next
        Case Else
             GoSub WrongTypeError: With Err: .Raise .Number, .source, .Description: End With
        End Select
    End If
    
    AsBooleanArray = sourceAsBooleanArray
    Exit Function

' CERTAIN RE-USED CODE.
CommonValidationOnSourceElement:
    If source(Index) < 1 Or source(Index) > arraySize Then
        GoSub ElementDoesNotExistError: With Err: .Raise .Number, .source, .Description: End With
    ' If element has already been set to true, there is a problem.
    ElseIf sourceAsBooleanArray(source(Index)) = True Then
        GoSub ElementAlreadySpecifiedError: With Err: .Raise .Number, .source, .Description: End With
    End If
    Return
    
' ERROR-HANDLING CODE.

StartCodeForErrorHandler:
    Dim ErrorInformation As New Dictionary
    With ErrorInformation
    Return

' General Errors.
CannotConvertObjectError:
        GoSub StartCodeForErrorHandler:
        ![1] = 1050 + 1
        ![2] = "source is an object which is not a valid type for the parameter."
        GoTo EndCodeForErrorHandler:
SpecifiedSizeNotValidError:
        GoSub StartCodeForErrorHandler:
        ![1] = 1050 + 2
        ![2] = "Array size specified must be greater than 0."
        GoTo EndCodeForErrorHandler:
WrongTypeError:
        GoSub StartCodeForErrorHandler:
        ![1] = 1050 + 3
        ![2] = "VarType(source) returns " & TypeOfSource & " which isn't a valid value." _
                    & vbNewLine & vbNewLine & _
               "TypeName(source) : " & TypeName(source)
        GoTo EndCodeForErrorHandler:
    
' Array Errors.
WrongNumberOfDimensionsError:
        GoSub StartCodeForErrorHandler:
        ![1] = 1100 + 1
        ![2] = "source array doesn't have the right number of dimensions." _
                    & vbNewLine & vbNewLine & _
               "DimensionCount(source) : " & DimensionCount(source)
        GoTo EndCodeForErrorHandler:
ArrayTooBigError:
        GoSub StartCodeForErrorHandler:
        ![1] = 1100 + 2
        ![2] = "source has more elements than the size specified which should not be the case." _
                    & vbNewLine & vbNewLine & _
               "arraySize : " & arraySize & vbNewLine & _
               "UBound(source) - LBound(source) : " & UBound(source) - LBound(source)
        GoTo EndCodeForErrorHandler:
WrongArrayTypeError:
        GoSub StartCodeForErrorHandler:
        ![1] = 1100 + 3
        ![2] = "source has wrong array type. The suitable array types are: " & _
                    "boolean, byte, integer, long & variant." & vbNewLine & vbNewLine & _
               "TypeName(source) : " & TypeName(source)
        GoTo EndCodeForErrorHandler:

' Array Element Errors.
ArrayElementError:
        GoSub StartCodeForErrorHandler:
        Dim IndexString$: IndexString = "Index : " & Index
        Dim VarTypeOfElementString$
        VarTypeOfElementString = "VarType(source(Index)) : " & varType(source(Index))
        ![1] = 1110
        Return
    
ElementIsObjectError:
        GoSub ArrayElementError:
        ![1] = ![1] + 1
        ![2] = "source(Index) is an object which shouldn't be the case. " & vbNewLine & vbNewLine & _
               IndexString & vbNewLine & _
               "TypeName(source(Index)) : " & TypeName(source(Index))
        GoTo EndCodeForErrorHandler:
ElementCategoryShouldBe1Error:
        GoSub ArrayElementError:
        ![1] = ![1] + 2
        ![2] = "source(Index) isn't byte, integer or long. whereas the previous elements in the " & _
                    "array are each one of these. This is not allowed." & vbNewLine & vbNewLine & _
               IndexString & vbNewLine & _
               VarTypeOfElementString
        GoTo EndCodeForErrorHandler:
ElementShouldBeBooleanError:
        GoSub ArrayElementError:
        ![1] = ![1] + 3
        ![2] = "source(Index) is not boolean but the previous elements in the array are boolean. " & _
                    "This is not allowed." & vbNewLine & vbNewLine & _
               IndexString & vbNewLine & _
               VarTypeOfElementString
        GoTo EndCodeForErrorHandler:
WrongElementTypeError:
        GoSub ArrayElementError:
        ![1] = ![1] + 4
        ![2] = "source(Index) does not have a suitable type. The suitable types are: " & _
                    "boolean, byte, integer & long." & vbNewLine & vbNewLine & _
               IndexString & vbNewLine & _
               VarTypeOfElementString
        GoTo EndCodeForErrorHandler:
ElementDoesNotExistError:
        GoSub ArrayElementError:
        ![1] = ![1] + 5
        ![2] = "source(Index) should be the position of an element in the output boolean array " & _
                    "but such a position cannot exist. " & vbNewLine & vbNewLine & _
               IndexString & vbNewLine & _
               "source(Index) : " & source(Index) & vbNewLine & _
               "arraySize : " & arraySize & vbNewLine & _
               "1 <= position <= arraySize"
        GoTo EndCodeForErrorHandler:
ElementAlreadySpecifiedError:
        GoSub ArrayElementError:
        ![1] = ![1] + 6
        ![2] = "source(Index) should be a unique value amongst the elements of source but " & _
                    "this is not the case." & vbNewLine & vbNewLine & _
               IndexString & vbNewLine & _
               "source(Index) : " & source(Index)
        GoTo EndCodeForErrorHandler:
    
' Binary Conversion Errors.
TooManyBinaryDigitsRequiredError:
        GoSub StartCodeForErrorHandler:
        ![1] = 1150 + 1
        ![2] = "source specifies a binary number that requires more bits " & _
                    "than the permitted size of the output array. This is not allowed." & vbNewLine & vbNewLine & _
               "source requires " & _
                    (Int(Round(Math.Log(IIf(source = 0, 1, source)) / Math.Log(2), 8)) + 1) & _
                    " binary digits to store its value whereas the output array must have size " & arraySize & "."
        GoTo EndCodeForErrorHandler:
EndCodeForErrorHandler:
        Err.Number = ![1]
        Err.Description = ![2]
    End With
    Err.source = "AsBooleanArray"
    AsBooleanArray = CVErr(Err.Number)
#If DebuggingMode = True Then
    Return
#End If
    
End Function

Private Function DimensionCount(arrayInVariant) As Byte
Attribute DimensionCount.VB_Description = "\nSimple function for counting number of dimensions in an array."
' Simple function for counting number of dimensions in an array.

        Dim ErrBackup As New Dictionary
        With ErrBackup
                ![1] = Err.Description: ![2] = Err.HelpContext: ![3] = Err.HelpFile: ![4] = Err.Number
                On Error GoTo FoundDimensionCount:
                Do
                        DimensionCount = DimensionCount + 1 + (LBound(arrayInVariant, DimensionCount + 1) And False)
                Loop
FoundDimensionCount:
                Err.Description = ![1]: Err.HelpContext = ![2]: Err.HelpFile = ![3]: Err.Number = ![4]
        End With
End Function