设为首页收藏本站Access中国
开启辅助访问 切换到宽版

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步，快速开始

Office中国论坛/Access中国论坛»论坛首页 › Access 资料区 › Access源码 › 关于红尘如烟“Access通用系统v1.1”基础上的改进
12下一页
返回列表 发新帖
查看: 5032|回复: 10
打印 上一主题 下一主题

[Access本身] 关于红尘如烟“Access通用系统v1.1”基础上的改进

[复制链接]
caoguangyao
跳转到指定楼层
1#
发表于 2012-12-12 18:01:51 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
本帖最后由 caoguangyao 于 2012-12-12 22:19 编辑

     
谢谢红尘如烟无私奉献！我一直在用你的“Access通用系统v1.1”，让我受益匪浅。{:soso_e183:}
      我想，其他用过“Access通用系统v1.1”的人，与我一样，有些小小问题--就是当后台数据库中的业务表，一个个添加时，不得不手动，到“LinkData”函数中去添加一些代码。可能有人与我一样，有这样的想法：当在后台数据库中，每增加一个或多个业务表时，能否自动添加业务表的链接？我想，通过一些处理，应该是可的，试了多种方法，觉得有一种方法，可让我们轻松起来。因为在后台数据库中，有一个系统表“MSysObjects”，它记录了后台数据库中，所有表的添加与删除。方法如下：
1、我们可以手动（且仅且一次），将“MSysObjects”  表，链接到前台数据库中，并命名为“MSysObjects1”，相应地在“LinkData”函数中去添加两行代码：[gstrSourceTableName(9) = "MSysObjects"，gstrLinkTableName(9) = "MSysObjects1"]，
将“gintTablesCount = 8”修改为“gintTablesCount = 9”，好了，下次打开前台数据库时，后台数据库中系统表“MSysObjects”，就会自动链接到前台数据库中。
2、在“LinkData”函数中，创建一记录集，添加的代码如下：
    Dim i As Integer
    Dim str As String
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    str = "select * from MSysObjects1 where left(name,4)<>'usys' and Flags=0 and Type=1 "  '排除系统表，只添加业务表
    rs.Open str, CurrentProject.Connection, 3, 3
    i = rs.RecordCount
3、重定义：
    ReDim gstrSourceTableName(1 To gintTablesCount + i)
    ReDim gstrLinkTableName(1 To gintTablesCount + i)
4、循环记录集，将业务表保存在数组中：
    '-------------以下为链接业务数据表cgy2012-10-9
    If rs.RecordCount >= 1 Then
    rs.MoveFirst
    For i = 1 To i
        gstrSourceTableName(gintTablesCount + i) = rs("name")
    rs.MoveNext
    Next
    End If
5、将原代码：
[    For intI = 1 To gintTablesCount
        If Trim$(gstrLinkTableName(intI)) = "" Then gstrLinkTableName(intI) = gstrSourceTableName(intI)
        On Error Resume Next
        '删除原来的链接表
        DoCmd.DeleteObject acTable, gstrLinkTableName(intI)
        On Error GoTo Err_LinkData
    Next]
修改为：
[    For intI = 1 To gintTablesCount + i
        If Trim$(gstrLinkTableName(intI)) = "" Then gstrLinkTableName(intI) = gstrSourceTableName(intI)
        On Error Resume Next
        '删除原来的链接表
        DoCmd.DeleteObject acTable, gstrLinkTableName(intI)
        'On Error GoTo Err_LinkData '这一句必须注释,cgy2012-12-2
    Next]
6、将原代码：
[    '显示进度指示
    With clsGuage
        .Caption = "正在链接后台数据库……"
        .Max = gintTablesCount
        For intI = 1 To gintTablesCount
            On Error Resume Next
            DoCmd.DeleteObject acTable, gstrSourceTableName(intI)
            On Error GoTo Err_LinkData
            '创建链接表
            Set tdf = CurrentDb.CreateTableDef(gstrSourceTableName(intI))
SetupPassword:
            tdf.Connect = "MS Access;DATABASE=" & PathName
            If strPassword <> "" Then tdf.Connect = tdf.Connect & ";WD=" & strPassword
            tdf.SourceTableName = gstrSourceTableName(intI)
            tdf.Name = gstrLinkTableName(intI)
            CurrentDb.TableDefs.Append tdf
            '显示进度
            .Value = intI
        Next
    End With]
修改为：
[    '显示进度指示
    With clsGuage
        .Caption = "正在链接后台数据库……"
        .Max = gintTablesCount + i
        For intI = 1 To gintTablesCount + i
            On Error Resume Next
            DoCmd.DeleteObject acTable, gstrSourceTableName(intI)
            'On Error GoTo Err_LinkData '这一句必须注释,cgy2012-12-2
            '创建链接表
            Set tdf = CurrentDb.CreateTableDef(gstrSourceTableName(intI))
SetupPassword:
            tdf.Connect = "MS Access;DATABASE=" & PathName
            If strPassword <> "" Then tdf.Connect = tdf.Connect & "WD=" & strPassword
            tdf.SourceTableName = gstrSourceTableName(intI)
            tdf.Name = gstrLinkTableName(intI)
            CurrentDb.TableDefs.Append tdf
            '显示进度
            .Value = intI
        Next
    End With]
7、添加代码：
rs.Close
Set rs = Nothing
****************************************************************************************
                             修改后的代码清单
****************************************************************************************
'链接后台数据（即创建链接表）
Public Function LinkData(PathName As String, Optional Password As String) As Boolean
    On Error GoTo Err_LinkData
   
    Dim intI As Integer
    Dim tdf As Object
    Dim strPassword As String
    Dim clsGuage As New clsProcessBar
   
    If PathName = "" Then Exit Function
   
    Dim i As Integer
    Dim str As String
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    str = "select * from MSysObjects1 where left(name,4)<>'usys' and Flags=0 and Type=1 "
    rs.Open str, CurrentProject.Connection, 3, 3
    i = rs.RecordCount
   
    gintTablesCount = 9
   
    ReDim gstrSourceTableName(1 To gintTablesCount + i)
    ReDim gstrLinkTableName(1 To gintTablesCount + i)
   
    gstrSourceTableName(1) = "USysUsers"
    gstrSourceTableName(2) = "USysUserGroups"
    gstrSourceTableName(3) = "USysMenuItems"
    gstrSourceTableName(4) = "USysIcons"
    gstrSourceTableName(5) = "USysUserRights"
    gstrSourceTableName(6) = "USysSoftwareInfo"
    gstrSourceTableName(7) = "USysOperateLog"
    gstrSourceTableName(8) = "USysErrorLog"
    gstrSourceTableName(9) = "MSysObjects"
   
    gstrLinkTableName(7) = "登录/操作日志"
    gstrLinkTableName(8) = "错误日志"
    gstrLinkTableName(9) = "MSysObjects1"
    '-------------以下为链接业务数据表cgy2012-10-9
    If rs.RecordCount >= 1 Then
    rs.MoveFirst
    For i = 1 To i
        gstrSourceTableName(gintTablesCount + i) = rs("name")
    rs.MoveNext
    Next
    End If
    '如果没有指定新表名，则使用源表名作为链接表名
    For intI = 1 To gintTablesCount + i
        If Trim$(gstrLinkTableName(intI)) = "" Then gstrLinkTableName(intI) = gstrSourceTableName(intI)
        On Error Resume Next
        '删除原来的链接表
        DoCmd.DeleteObject acTable, gstrLinkTableName(intI)
        'On Error GoTo Err_LinkData '这一句必须注释,cgy2012-12-2
    Next
    '显示进度指示
    With clsGuage
        .Caption = "正在链接后台数据库……"
        .Max = gintTablesCount + i
        For intI = 1 To gintTablesCount + i
            On Error Resume Next
            DoCmd.DeleteObject acTable, gstrSourceTableName(intI)
            'On Error GoTo Err_LinkData '这一句必须注释,cgy2012-12-2
            '创建链接表
            Set tdf = CurrentDb.CreateTableDef(gstrSourceTableName(intI))
SetupPassword:
            tdf.Connect = "MS Access;DATABASE=" & PathName
            If strPassword <> "" Then tdf.Connect = tdf.Connect & "WD=" & strPassword
            tdf.SourceTableName = gstrSourceTableName(intI)
            tdf.Name = gstrLinkTableName(intI)
            CurrentDb.TableDefs.Append tdf
            '显示进度
            .Value = intI
        Next
    End With
    LinkData = True
    Password = strPassword
rs.Close
Set rs = Nothing
Exit_LinkData:
    Exit Function
Err_LinkData:
    If Err = 3031 Then
        If strPassword = "" And Password <> "" Then
            strPassword = Password
            Resume SetupPassword
        Else
            strPassword = fInputBox("请输入访问数据库文件 '" & PathName & "' 的正确密码：", "输入密码", True)
            If strPassword <> "" Then
                Resume SetupPassword
            Else
                MsgBox "因无有效密码，系统不能识别此数据库文件。", vbCritical
            End If
        End If
'    Else
'        MsgBox Err.Description, vbCritical
    End If
    Resume Exit_LinkData
End Function


本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有帐号？注册

x

评分

参与人数 1经验 +5 收起 理由
zhuyiwen + 5 很给力!

查看全部评分

分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏2 分享分享 分享淘帖 订阅订阅
回复

使用道具 举报

zhuyiwen

点击这里给我发消息
2#
发表于 2012-12-12 19:35:47 | 只看该作者
好办法！
回复 支持 反对

使用道具 举报

yanwei82123300
3#
发表于 2012-12-12 19:50:20 | 只看该作者
谢谢红尘如烟无私奉献！我一直在用你的“Access通用系统v1.1”，让我受益匪浅。我现在有一个问题：添加菜单和控制面板时为什么只支持MSysObjects表中Flags=0，的查询查询，窗体，宏，报表，为何不支持直接打开 表，Flags<>0d的查询，表呢？谢谢
回复 支持 反对

使用道具 举报

tmtony

点击这里给我发消息
4#
发表于 2012-12-12 22:38:01 | 只看该作者
阿耀, 很详细,很用心,很给力啊
回复 支持 反对

使用道具 举报

caoguangyao
5#
 楼主| 发表于 2012-12-12 22:51:45 | 只看该作者
谢谢王老师的鼓励！
回复 支持 反对

使用道具 举报

wufeng980114
6#
发表于 2012-12-13 08:43:14 | 只看该作者
学习了，不错啊
回复 支持 反对

使用道具 举报

竹笛
7#
发表于 2012-12-13 09:46:31 | 只看该作者

关于红尘如烟“Access通用系统v1.1”基础上的改进（转载）

原文作者： 曹光耀    QQ：1779230348
谢谢红尘如烟无私奉献！我一直在用你的“Access通用系统v1.1”，让我受益匪浅。
我想，其他用过“Access通用系统v1.1”的人，与我一样，有些小小问题--就是当后台数据库中的业务表，一个个添加时，不得不手动，到“LinkData”函数中去添加一些代码。可能有人与我一样，有这样的想法：当在后台数据库中，每增加一个或多个业务表时，能否自动添加业务表的链接？我想，通过一些处理，应该是可以的，试了多种方法，觉得有一种方法，可让我们轻松起来。因为在后台数据库中，有一个系统表“MSysObjects”，它记录了后台数据库中，所有表的添加与删除。方法如下：
1、我们可以手动（且仅且一次），将“MSysObjects” 表，链接到前台数据库中，并命名为“MSysObjects1”，相应地在“LinkData”函数中去添加两行代码：[gstrSourceTableName(9) = "MSysObjects"，gstrLinkTableName(9) = "MSysObjects1"]，
将“gintTablesCount = 8”修改为“gintTablesCount = 9”，好了，下次打开前台数据库时，后台数据库中系统表“MSysObjects”，就会自动链接到前台数据库中。
2、在“LinkData”函数中，创建一记录集，添加的代码如下：
Dim i As Integer
Dim str As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
str = "select * from MSysObjects1 where left(name,4)<>'usys' and Flags=0 and Type=1 " '排除系统表，只添加业务表
rs.Open str, CurrentProject.Connection, 3, 3
i = rs.RecordCount
3、重定义：
ReDim gstrSourceTableName(1 To gintTablesCount + i)
ReDim gstrLinkTableName(1 To gintTablesCount + i)
4、循环记录集，将业务表保存在数组中：
'-------------以下为链接业务数据表cgy2012-10-9
If rs.RecordCount >= 1 Then
rs.MoveFirst
For i = 1 To i
gstrSourceTableName(gintTablesCount + i) = rs("name")
rs.MoveNext
Next
End If
5、将原代码：
[ For intI = 1 To gintTablesCount
If Trim$(gstrLinkTableName(intI)) = "" Then gstrLinkTableName(intI) = gstrSourceTableName(intI)
On Error Resume Next
'删除原来的链接表
DoCmd.DeleteObject acTable, gstrLinkTableName(intI)
On Error GoTo Err_LinkData
Next]
修改为：
[ For intI = 1 To gintTablesCount + i
If Trim$(gstrLinkTableName(intI)) = "" Then gstrLinkTableName(intI) = gstrSourceTableName(intI)
On Error Resume Next
'删除原来的链接表
DoCmd.DeleteObject acTable, gstrLinkTableName(intI)
'On Error GoTo Err_LinkData '这一句必须注释,cgy2012-12-2
Next]
6、将原代码：
[ '显示进度指示
With clsGuage
.Caption = "正在链接后台数据库……"
.Max = gintTablesCount
For intI = 1 To gintTablesCount
On Error Resume Next
DoCmd.DeleteObject acTable, gstrSourceTableName(intI)
On Error GoTo Err_LinkData
'创建链接表
Set tdf = CurrentDb.CreateTableDef(gstrSourceTableName(intI))
SetupPassword:
tdf.Connect = "MS Access;DATABASE=" & PathName
If strPassword <> "" Then tdf.Connect = tdf.Connect & ";WD=" & strPassword
tdf.SourceTableName = gstrSourceTableName(intI)
tdf.Name = gstrLinkTableName(intI)
CurrentDb.TableDefs.Append tdf
'显示进度
.Value = intI
Next
End With]
修改为：
[ '显示进度指示
With clsGuage
.Caption = "正在链接后台数据库……"
.Max = gintTablesCount + i
For intI = 1 To gintTablesCount + i
On Error Resume Next
DoCmd.DeleteObject acTable, gstrSourceTableName(intI)
'On Error GoTo Err_LinkData '这一句必须注释,cgy2012-12-2
'创建链接表
Set tdf = CurrentDb.CreateTableDef(gstrSourceTableName(intI))
SetupPassword:
tdf.Connect = "MS Access;DATABASE=" & PathName
If strPassword <> "" Then tdf.Connect = tdf.Connect & "WD=" & strPassword
tdf.SourceTableName = gstrSourceTableName(intI)
tdf.Name = gstrLinkTableName(intI)
CurrentDb.TableDefs.Append tdf
'显示进度
.Value = intI
Next
End With]
7、添加代码：
rs.Close
Set rs = Nothing
****************************************************************************************
修改后的代码清单
****************************************************************************************
'链接后台数据（即创建链接表）
Public Function LinkData(PathName As String, Optional Password As String) As Boolean
On Error GoTo Err_LinkData

Dim intI As Integer
Dim tdf As Object
Dim strPassword As String
Dim clsGuage As New clsProcessBar

If PathName = "" Then Exit Function

Dim i As Integer
Dim str As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
str = "select * from MSysObjects1 where left(name,4)<>'usys' and Flags=0 and Type=1 "
rs.Open str, CurrentProject.Connection, 3, 3
i = rs.RecordCount

gintTablesCount = 9

ReDim gstrSourceTableName(1 To gintTablesCount + i)
ReDim gstrLinkTableName(1 To gintTablesCount + i)

gstrSourceTableName(1) = "USysUsers"
gstrSourceTableName(2) = "USysUserGroups"
gstrSourceTableName(3) = "USysMenuItems"
gstrSourceTableName(4) = "USysIcons"
gstrSourceTableName(5) = "USysUserRights"
gstrSourceTableName(6) = "USysSoftwareInfo"
gstrSourceTableName(7) = "USysOperateLog"
gstrSourceTableName(8) = "USysErrorLog"
gstrSourceTableName(9) = "MSysObjects"

gstrLinkTableName(7) = "登录/操作日志"
gstrLinkTableName(8) = "错误日志"
gstrLinkTableName(9) = "MSysObjects1"
'-------------以下为链接业务数据表cgy2012-10-9
If rs.RecordCount >= 1 Then
rs.MoveFirst
For i = 1 To i
gstrSourceTableName(gintTablesCount + i) = rs("name")
rs.MoveNext
Next
End If
'如果没有指定新表名，则使用源表名作为链接表名
For intI = 1 To gintTablesCount + i
If Trim$(gstrLinkTableName(intI)) = "" Then gstrLinkTableName(intI) = gstrSourceTableName(intI)
On Error Resume Next
'删除原来的链接表
DoCmd.DeleteObject acTable, gstrLinkTableName(intI)
'On Error GoTo Err_LinkData '这一句必须注释,cgy2012-12-2
Next
'显示进度指示
With clsGuage
.Caption = "正在链接后台数据库……"
.Max = gintTablesCount + i
For intI = 1 To gintTablesCount + i
On Error Resume Next
DoCmd.DeleteObject acTable, gstrSourceTableName(intI)
'On Error GoTo Err_LinkData '这一句必须注释,cgy2012-12-2
'创建链接表
Set tdf = CurrentDb.CreateTableDef(gstrSourceTableName(intI))
SetupPassword:
tdf.Connect = "MS Access;DATABASE=" & PathName
If strPassword <> "" Then tdf.Connect = tdf.Connect & "WD=" & strPassword
tdf.SourceTableName = gstrSourceTableName(intI)
tdf.Name = gstrLinkTableName(intI)
CurrentDb.TableDefs.Append tdf
'显示进度
.Value = intI
Next
End With
LinkData = True
Password = strPassword
rs.Close
Set rs = Nothing
Exit_LinkData:
Exit Function
Err_LinkData:
If Err = 3031 Then
If strPassword = "" And Password <> "" Then
strPassword = Password
Resume SetupPassword
Else
strPassword = fInputBox("请输入访问数据库文件 '" & PathName & "' 的正确密码：", "输入密码", True)
If strPassword <> "" Then
Resume SetupPassword
Else
MsgBox "因无有效密码，系统不能识别此数据库文件。", vbCritical
End If
End If
' Else
' MsgBox Err.Description, vbCritical
End If
Resume Exit_LinkData
End Function

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有帐号？注册

x
回复 支持 反对

使用道具 举报

竹笛
8#
发表于 2012-12-13 10:30:20 | 只看该作者
哈哈，我还特意查了一下，没找到才转发的
回复 支持 反对

使用道具 举报

xie62
9#
发表于 2012-12-13 13:12:08 | 只看该作者
学习了
回复 支持 反对

使用道具 举报

zhuhero88
10#
发表于 2019-5-9 15:02:03 | 只看该作者
34567890-
回复

使用道具 举报

下一页 »
12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-25 06:51 , Processed in 0.099819 second(s), 40 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表