如何獲取數組的維數(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)