如何在VBA 2007中确定对象变量的完全限定类和成员名称？

在同时引用Excel和Word对象库的VBA项目中，区分Range对象属于哪个类确实很关键——毕竟两者是完全不同的类型。你遇到的问题是原代码返回的是带应用程序全称的名称（比如"Microsoft Excel.Range"），而你需要和代码写法一致的"Excel.Range"或"Word.Range"。下面提供几种可行的解决方案：

方法1：利用Application的ProgID（简单高效） #

这个方法不需要复杂的API调用，完全基于VBA内置属性，对Excel和Word的Range对象非常适用：

'Note: Project has references to both Excel and Word.
Public Sub Demo()
    Dim r As Excel.Range
    Dim fulltype As String
    Set r = ActiveCell
    fulltype = WhatAmI(r)
    Debug.Print fulltype ' 输出 "Excel.Range"
    Select Case fulltype
        Case "Excel.Range"
            '处理Excel Range的逻辑
        Case "Word.Range"
            '处理Word Range的逻辑
    End Select
End Sub

Private Function WhatAmI(ByRef X As Object) As String
    Dim appProgID As String
    Dim libPrefix As String
    Dim objTypeName As String
    
    objTypeName = TypeName(X)
    ' 获取应用程序的ProgID（比如Excel的是"Excel.Application"，Word的是"Word.Application"）
    appProgID = X.Application.ProgID
    ' 截取前缀部分（比如从"Excel.Application"中取出"Excel"）
    libPrefix = Left(appProgID, InStr(appProgID, ".") - 1)
    
    WhatAmI = libPrefix & "." & objTypeName
End Function

原理说明 #

• X.Application.ProgID返回的是应用程序的编程标识符，格式固定为[库前缀].Application，拆分后就能得到我们需要的Excel或Word前缀。
• TypeName(X)返回对象的类名（比如"Range"），两者拼接就得到了完全限定的类名。

方法2：通用型API方法（适用于所有COM对象） #

如果你需要处理更多类型的COM对象，或者对象没有Application属性，可以用这个基于OLE API的方法，它能直接从对象的类型信息中获取库名称和类名：

首先需要声明API函数和类型（放在模块顶部）：

Private Declare Function ObjQueryInterface Lib "ole32.dll" (ByVal pUnk As Object, ByRef riid As GUID, ByRef ppvObj As Any) As Long
Private Declare Function ObjGetTypeInfo Lib "oleaut32.dll" (ByVal pUnk As Object, ByVal itinfo As Long, ByVal lcid As Long, ByRef pptinfo As Any) As Long
Private Declare Function TypeInfoGetDocumentation Lib "oleaut32.dll" (ByVal ptinfo As Long, ByVal memid As Long, ByRef pBstrName As Long, ByRef pBstrDocString As Long, ByRef pdwHelpContext As Long, ByRef pBstrHelpFile As Long) As Long
Private Declare Function TypeInfoGetContainingTypeLib Lib "oleaut32.dll" (ByVal ptinfo As Long, ByRef pptlib As Long, ByRef pIndex As Long) As Long
Private Declare Function TypeLibGetDocumentation Lib "oleaut32.dll" (ByVal ptlib As Long, ByVal index As Long, ByRef pBstrName As Long, ByRef pBstrDocString As Long, ByRef pdwHelpContext As Long, ByRef pBstrHelpFile As Long) As Long
Private Declare Function SysFreeString Lib "oleaut32.dll" (ByVal pBstr As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Private Function SysString(ByVal ptr As Long) As String
    SysString = String$(LenB(ptr), vbNullChar)
    CopyMemory ByVal SysString, ByVal ptr, LenB(ptr)
End Function

然后编写获取完全限定类名的函数：

Private Function GetFullTypeName(obj As Object) As String
    Dim ti As Long
    Dim tl As Long
    Dim libNamePtr As Long
    Dim typeNamePtr As Long
    Dim iidITypeInfo As GUID
    Dim hr As Long
    
    ' 设置ITypeInfo的GUID
    With iidITypeInfo
        .Data1 = &H00020400
        .Data2 = &H0
        .Data3 = &H0
        .Data4(0) = &HC0
        .Data4(7) = &H46
    End With
    
    ' 获取ITypeInfo指针
    hr = ObjQueryInterface(obj, iidITypeInfo, ti)
    If hr <> 0 Then Exit Function
    
    ' 获取包含的类型库
    hr = TypeInfoGetContainingTypeLib(ti, tl, 0)
    If hr <> 0 Then
        Call ObjQueryInterface(ti, iidITypeInfo, 0)
        Exit Function
    End If
    
    ' 获取类型库名称
    hr = TypeLibGetDocumentation(tl, -1, libNamePtr, 0, 0, 0)
    If hr <> 0 Then
        Call ObjQueryInterface(tl, iidITypeInfo, 0)
        Call ObjQueryInterface(ti, iidITypeInfo, 0)
        Exit Function
    End If
    
    ' 获取类型名称
    hr = TypeInfoGetDocumentation(ti, 0, typeNamePtr, 0, 0, 0)
    If hr <> 0 Then
        SysFreeString libNamePtr
        Call ObjQueryInterface(tl, iidITypeInfo, 0)
        Call ObjQueryInterface(ti, iidITypeInfo, 0)
        Exit Function
    End If
    
    ' 拼接结果
    GetFullTypeName = StrConv(SysString(libNamePtr), vbUnicode) & "." & StrConv(SysString(typeNamePtr), vbUnicode)
    
    ' 释放资源
    SysFreeString libNamePtr
    SysFreeString typeNamePtr
    Call ObjQueryInterface(tl, iidITypeInfo, 0)
    Call ObjQueryInterface(ti, iidITypeInfo, 0)
End Function

最后修改WhatAmI函数调用它：

Private Function WhatAmI(ByRef X As Object) As String
    WhatAmI = GetFullTypeName(X)
End Function

原理说明 #

这个方法通过OLE API直接读取对象的类型信息，从类型库中提取库名称（比如"Excel"）和类名称（比如"Range"），是最通用的解决方案，适用于任何COM对象。

额外建议：直接用TypeOf判断类型 #

如果你不需要字符串形式的类名，直接用TypeOf判断类型会更可靠，避免字符串比较可能出现的错误：

Public Sub Demo()
    Dim r As Excel.Range
    Set r = ActiveCell
    
    If TypeOf r Is Excel.Range Then
        Debug.Print "处理Excel Range对象"
        ' 你的Excel逻辑
    ElseIf TypeOf r Is Word.Range Then
        Debug.Print "处理Word Range对象"
        ' 你的Word逻辑
    End If
End Sub

内容的提问来源于stack exchange，提问作者spinjector