Access开发培训
网站公告
·Access专家课堂QQ群号:151711184    ·Access快速开发平台下载地址及教程    ·欢迎加入Access专家课堂微信群!    ·如何快速搜索本站文章|示例|资料    
您的位置: 首页 > 技术文章 > 源码示例

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

时 间:2013-02-21 22:05:47
作 者:宽一   ID:17481  城市:廊坊
摘 要:http://www.accessoft.com/article-show.asp?id=7750的作者对“Access通用系统v1.1”进行了改动,在手动基础上能自动添加链接表,但是手动添加的MSysObjects的路径是绝对路径,不能移植,与原意图相悖。
在网友SuperQ的帮助下,修改“LinkData”函数,直接访问后台数据库的MSysObjects,实现全自动添加链接表
正 文:

http://www.accessoft.com/article-show.asp?id=7750者对“Access通用系统v1.1”进行了改动,在手动基础上能自动添加链接表,但是手动添加的MSysObjects的路径是绝对路径,不能移植,与原意图相悖。

在网友SuperQ的帮助下,修改“LinkData”函数,直接访问后台数据库的MSysObjects,实现全自动添加链接表。

修改后的代码如下:

 '链接后台数据(即创建链接表)
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, gstrSourceTable, gstrLinkTable As String
    Dim clsGuage As New clsProcessBar

    If PathName = "" Then Exit Function

    Dim db As Database
    Dim ws As Workspace
    Dim rst As Recordset
    Set ws = DBEngine.Workspaces(0)
    Set db = ws.OpenDatabase(PathName, False, False, "MS Access;PWD=" + Password)
    Set rst = db.OpenRecordset("MSysObjects", 1)
    If rst.RecordCount > 0 Then
        ReDim gstrSourceTableName(1 To rst.RecordCount)
        ReDim gstrLinkTableName(1 To rst.RecordCount)
    End If

    gintTablesCount = 0
    Do Until rst.EOF
        If rst("Flags") = 0 And rst("Type") = 1 Then
            ' MsgBox rst!Name
            gintTablesCount = gintTablesCount + 1

            gstrSourceTableName(gintTablesCount) = rst!Name
            '如果没有指定新表名,则使用源表名作为链接表名
            If Trim$(gstrLinkTableName(gintTablesCount)) = "" Then gstrLinkTableName(gintTablesCount) = gstrSourceTableName(gintTablesCount)
            On Error Resume Next
            '删除原来的链接表
            DoCmd.DeleteObject acTable, gstrLinkTableName(gintTablesCount)
        End If
        rst.MoveNext
    Loop

    '显示进度指示
    With clsGuage
        .Caption = "正在链接后台数据库……"
        .Max = gintTablesCount
        For intI = 1 To gintTablesCount
            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
            End If
            tdf.SourceTableName = gstrSourceTableName(intI)
            tdf.Name = gstrLinkTableName(intI)
            CurrentDb.TableDefs.Append tdf
            '显示进度
            .Value = intI
        Next
    End With


    LinkData = True
    Password = strPassword

    rst.Close
    db.Close


Exit_LinkData:
    Exit Function
Err_LinkData:
    If Err = 3031 Then
        MsgBox Err.Description
        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

 



Access软件网QQ交流群 (群号:54525238)       Access源码网店

常见问答:

技术分类:

相关资源:

专栏作家

关于我们 | 服务条款 | 在线投稿 | 友情链接 | 网站统计 | 网站帮助