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的一些缺陷