CallByName的深入研究

由于工作的需要，我希望将长长的Case取消掉，但是CallbyName在层次和集合对象上的处理十分头疼，为了解决这个问题只能想别的办法了，唯一的办法是重新包装Callbyname，代码如下：

'ClassName :ParaseTier

'缺陷没有考虑错误处理

Public Event onError()

'根据字符串得到具体的属性值
Public Function GetAttributeValue(Object As Object, ByVal AttributeName As String)
    GetAttributeValue = VBA.Interaction.CallByName(GetObject(Object, AttributeName), Trim(AttributeName), VbGet)
End Function

'根据字符串得到具体的对象
'AttributeIsObject = 0,表示当AttributeName表示的是属性名称
'AttributeIsObject = 1,表示当AttributeName表示的是对象名称
Public Function GetObject(ByVal Object As Object, ByRef AtrributeName As String, Optional AttributeIsObject = 0) As Object
    Dim parseProcName() As String
    parseProcName = Split(AtrributeName, ".")
    Dim i As Integer
    Set GetObject = Object
    For i = 0 To UBound(parseProcName) - 1
       If IsCollectionAttribute(parseProcName(i)) Then
            Set GetObject = GetItemObject(GetObject, parseProcName(i))
       Else
            If IsObject(VBA.Interaction.CallByName(GetObject, parseProcName(i), VbGet)) Then
                Set GetObject = VBA.Interaction.CallByName(GetObject, parseProcName(i), VbGet)
            End If
       End If
    Next
    
    '处理需要单独返回对象的属性
    If AttributeIsObject = 1 Then
        If IsObject(VBA.Interaction.CallByName(GetObject, parseProcName(0), VbGet)) Then
            Set GetObject = VBA.Interaction.CallByName(GetObject, parseProcName(0), VbGet)
        End If
    End If
    
    AtrributeName = parseProcName(UBound(parseProcName))
    Erase parseProcName
End Function

'解析集合类对象
'用来解释如“Sections(1)”格式的集合对象
'要求集合对象必须包含Item方法
'字符串不允许包含类似Item(1)的方法
Public Function GetItemObject(ByVal Object As Object, ByVal AttributeName As String) As Object
    Dim parseProcName() As String
    parseProcName = Split(AttributeName, "(")
    AttributeName = Trim(parseProcName(0))
    Dim Index As Integer
    Index = Trim(Replace(parseProcName(1), ")", ""))
    Set GetItemObject = GetObject(Object, AttributeName, 1)
    Set GetItemObject = GetItemObject.Item(Index)
    Erase parseProcName
End Function

'判断当前的对象是否为集合对象
Private Function IsCollectionAttribute(ByVal AttributeName As String) As Boolean
    IsCollectionAttribute = (InStr(1, AttributeName, "(") > 0)
End Function

相关测试类：

'ClassName :Student
Public Name As String
Public Sex As String

测试模块：

Public Sub Test1()
    Dim pt As New ParaseTier
    Dim o As Object
    Set o = Word.Application.ActiveDocument
    
    'Demo 使用字符串获得属性
    Debug.Print pt.GetAttributeValue(o, "Paragraphs(1).Range.Font.Name")
    
    'Demo 使用字符串获得集合对象属性
    Debug.Print pt.GetItemObject(o, "Paragraphs(1)").Range.Font.Name
    
    'Demo 使用字符串获得对象
    Debug.Print pt.GetObject(o, "Paragraphs", 1).Count
    
    Set o = Nothing
    Set pt = Nothing
End Sub


Public Sub Test2()
    Dim pt As New ParaseTier
    Dim o As Object
    Set o = Word.Application.ActiveDocument
    'Demo 使用字符串获得属性
    Debug.Print pt.GetAttributeValue(o, "Paragraphs(1).Range.Font.Name")
    'Demo 使用字符串获得集合对象属性
    Debug.Print pt.GetItemObject(o, "Sections(1)").Index
    'Demo 使用字符串获得对象
    Debug.Print pt.GetObject(o, "Paragraphs", 1).Count
    Set o = Nothing
    Set pt = Nothing
End Sub

Public Sub test3()
    Dim s As New Student
    s.Name = "Duiker"
    s.Sex = "男"
    Dim ss As String
    ss = InputBox("请输入需要获得的属性名称", "Name")
    
    Select Case ss
        Case "Name"
            Debug.Print s.Name
        Case "Sex"
            Debug.Print s.Sex
    End Select
    
    Set s = Nothing
End Sub

Public Sub test4()
    Dim s As New Student
    s.Name = "Duiker"
    s.Sex = "男"
    Dim ss As String
    ss = InputBox("请输入需要获得的属性名称", "Name")
    Dim pt As New ParaseTier
    Debug.Print pt.GetAttributeValue(s, ss)
    Set s = Nothing
End Sub

这只是一个简易的框架，自己用来玩玩还行，主要的好处就是通过字符串可以快速的生成对象，或者获取属性的值，而且支持多层次的属性字符串，也支持类似于Item格式的对象集合。

参考文章：

1：vb6框架设计-对象导航
2：CallByName的一些缺陷