Office中国论坛/Access中国论坛

标题: 关于红尘如烟“Access通用系统v1.1”基础上的改进 [打印本页]

作者: caoguangyao 时间: 2012-12-12 18:01
标题: 关于红尘如烟“Access通用系统v1.1”基础上的改进
本帖最后由 caoguangyao 于 2012-12-12 22:19 编辑

[attach]50913[/attach][attach]50913[/attach]
谢谢红尘如烟无私奉献！我一直在用你的“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

作者: zhuyiwen 时间: 2012-12-12 19:35
好办法！

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

作者: tmtony 时间: 2012-12-12 22:38
阿耀, 很详细,很用心,很给力啊

作者: caoguangyao 时间: 2012-12-12 22:51
谢谢王老师的鼓励！

作者: wufeng980114 时间: 2012-12-13 08:43
学习了，不错啊

作者: 竹笛 时间: 2012-12-13 09:46
标题: 关于红尘如烟“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

[attach]50920[/attach]

作者: 竹笛 时间: 2012-12-13 10:30
哈哈，我还特意查了一下，没找到才转发的

作者: xie62 时间: 2012-12-13 13:12
学习了

作者: zhuhero88 时间: 2019-5-9 15:02
34567890-

作者: qbtan85 时间: 2019-7-21 09:50
大家的文件大小是多少？

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)