【Access小品】遍历--Access常用手段

todaynew

感谢首长和同志们支持

5988143

感谢首长和同志们支持
todaynew 发表于 2009-11-25 06:21

作品愈來愈精湛了~
要嚴重支持一下~
呵呵!

ynjxw

好东西！

zhanguoru

学习，谢谢！！

todaynew

增加两个函数：


Function GetObject(ObjectType As String, Accessname As String) As String
'功能:获取其他Access数据库中的对象字符串
'参数:ObjectType--类型参数，AllForms=窗体；AllReports=报表；AllMacros=宏；AllModules=模块；AllDataAccessPages=数据访问页
'     Accessname --Access数据库名称字符串
Dim appAccess As New Access.Application
Dim obj As AccessObject
Dim objs As Object
appAccess.OpenCurrentDatabase Accessname
appAccess.Visible = True
Select Case ObjectType
    Case "AllForms"
        Set objs = appAccess.CurrentProject.AllForms
    Case "AllReports"
        Set objs = appAccess.CurrentProject.AllReports
    Case "AllMacros"
        Set objs = appAccess.CurrentProject.AllMacros
    Case "AllModules"
        Set objs = appAccess.CurrentProject.AllModules
    Case "AllDataAccessPages"
        Set objs = appAccess.CurrentProject.AllDataAccessPages
    Case Else
        Exit Function
End Select
For Each obj In objs
    If obj.IsLoaded = False Then
        GetObject = GetObject & obj.Name & ";"
    End If
Next obj
appAccess.CloseCurrentDatabase
Set appAccess = Nothing
End Function

Function GetObjCtl(ObjectType As String, Accessname As String, Objectname As String) As String
'功能:获取其他Access数据库中的对象中控件字符串
'参数:ObjectType--类型参数，AllForms=窗体；AllReports=报表；AllMacros=宏；AllModules=模块；AllDataAccessPages=数据访问页
'     Accessname--Access数据库名称字符串
'     Objectname --对象名称字符串
Dim appAccess As New Access.Application
Dim ctls As Controls
Dim ctl As Control
Dim obj As Object
appAccess.OpenCurrentDatabase Accessname
appAccess.Visible = True
Select Case ObjectType
    Case "AllForms"
        appAccess.DoCmd.OpenForm Objectname
        Set obj = appAccess.Forms(Objectname)
    Case "AllReports"
        appAccess.DoCmd.OpenReport Objectname, acViewPreview
        Set obj = appAccess.Reports(Objectname)
    Case "AllDataAccessPages"
        appAccess.DoCmd.OpenDataAccessPage Objectname
        Set obj = appAccess.DataAccessPages(Objectname)
    Case Else
        Exit Function
End Select
Set ctls = obj.Controls
For Each ctl In ctls
    GetObjCtl = GetObjCtl & ctl.Name & ";"
Next ctl
appAccess.CloseCurrentDatabase
Set appAccess = Nothing
End Function

chaojianan

收藏了，谢谢todaynew。

heqing3000

收藏了。谢谢！

wufeng980114

谢谢了

ycxchen

谢谢，学习！

dragonszr

学习学习再学习!