如何获取数组的维数(API)

在VBA中并没有提供可以直接获取数组维数的函数和方法，前面的文章“如何获取数组的维数”介绍了，如何使用捕获错误的方法来获取数组的维数，本文介绍如何使用Windows API获取数组的维数。

---

示例代码如下：

Type SAFEARRAYBOUND
    cElements As Long
    lLbound As Long
End Type
Type SAFEARRAY
    cDims As Integer
    fFeatures As Integer
    cbElements As Long
    cLocks As Long
    pvData As Long
    rgsabound(1 To 60) As SAFEARRAYBOUND
End Type
Private Declare Sub CopyMemory Lib "kernel32" _
            Alias "RtlMoveMemory" ( _
            dest As Any, _
            source As Any, _
            ByVal bytes As Long)
Private Const VT_BYREF = &H4000&

Function blnGetArrayMsg(DataArray As Variant, Array_Msg As SAFEARRAY) As Boolean
    Dim lngPoint As Long
    Dim intVType As Integer
    If Not IsArray(DataArray) Then Exit Function
    With Array_Msg
        CopyMemory intVType, DataArray, 2
        CopyMemory lngPoint, ByVal VarPtr(DataArray) + 8, 4
        If (intVType And VT_BYREF) <> 0 Then
            CopyMemory lngPoint, ByVal lngPoint, 4
        End If
        CopyMemory Array_Msg.cDims, ByVal lngPoint, 16
        If Array_Msg.cDims > 0 Then
            CopyMemory .rgsabound(1), ByVal lngPoint + 16, _
                       Array_Msg.cDims * Len(.rgsabound(1))
            GetArray_Msg = Array_Msg.cDims
            blnGetArrayMsg = True
        End If
    End With
End Function

Sub Demo()
    Dim myArr(1, 2, 3, 100, 1000)
    Dim ud_Msg As SAFEARRAY
    If blnGetArrayMsg(myArr, ud_Msg) Then
        MsgBox "数组维度为：" & ud_Msg.cDims
    Else
        MsgBox "Error!"
    End If
End Sub

【代码解析】
示例代码使用API函数CopyMemory实现获取数组的维度信息，其中涉及内存复制、比特操作等，这里不进行详细讲解，有兴趣的可以搜索相关资料。

相关功能已经封装为自定义函数，可以使用如下形式调用，其中第一个参数为数组，第二参数为自定义类型数据结构SAFEARRAY，结果保存在cDims中。

blnGetArrayMsg(myArr, ud_Msg)