学步园

在一家使用Access开始程序的公司做项目,改进原系统成为支持Barcode的物流系统.

他们使用程序和数据分离的方法,Access的程序使用链接表指向原始表,就可以在程序中直接操作链接表就像操作本地表一样.由于将数据部署在服务器上做为生产数据库,则调试时将使用本地数据进行调试,在程序中就要频繁更改链接表的指向.以前他们都是手动进行修改很是忙烦,我看了下DAO的资料就写个小程序控制链接表.程序如下:

新增项目,引用DAO3.51,窗体上放三个TextBox,两个CommandButton,一个CommonDialog,和一个ProgressBar.编写代码如下:

Option Explicit

Private Sub cmdBrowse_Click(Index As Integer)
    Me.CommonDialog1.ShowOpen
    If Me.CommonDialog1.FileName <> "" Then
        Me.txtPath(0).Text = Me.CommonDialog1.FileName
    End If
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdProcess_Click()
    Dim i As Long, ok As Long, linkcount As Long
    For i = 0 To 2
        If Me.txtPath(i).Text = "" Then
            MsgBox "请填写所有路径!", vbOKOnly + vbInformation, "提示"
            Exit Sub
        End If
    Next
   
    Dim db As Database
    Set db = DBEngine.OpenDatabase(Me.txtPath(0).Text)
    Dim t As TableDef, s1 As String, s2 As String, s3 As String
    Me.ProgressBar1.Max = db.TableDefs.Count
    Me.ProgressBar1.Value = 0
    For Each t In db.TableDefs
        Me.ProgressBar1.Value = Me.ProgressBar1.Value + 1
        If t.Connect <> "" Then
            linkcount = linkcount + 1
            t.Connect = Replace(t.Connect, Me.txtPath(1).Text, Me.txtPath(2).Text)
            Dim find As Long
            find = InStr(1, t.Connect, Me.txtPath(2).Text)
            On Error Resume Next
            t.RefreshLink
            If DAO.Errors.Count <> 0 Then
                For i = 0 To DAO.Errors.Count - 1
                    If DAO.Errors(i).Number = "3011" Then                           '在目标表中未找到此表
                        If vbNo = MsgBox("更改链接表时发生目标表链接错误:" & vbCrLf & _
                                            DAO.Errors(i).Description, vbYesNo + vbInformation + vbDefaultButton2, "提示") Then
                            On Error GoTo errHandle:
                            Err.Raise vbObjectError, Me.Name, "用户中断操作!"
                        End If
                    Else
                        Debug.Print DAO.Errors(i).Description
                    End If
                Next
                DAO.Errors.Refresh
            Else
                If find <> 0 Then
                    ok = ok + 1
                End If
            End If
        End If
    Next
    MsgBox "链接表刷新完毕,数据库中总计有:" & _
                Me.ProgressBar1.Max & "个数据表,其中链接表为:" & linkcount & _
                "个,成功匹配操作:" & ok & "个数据表.", vbOKOnly + vbInformation, "提示"
    Exit Sub
errHandle:
    MsgBox Err.Number & "," & Err.Source & "," & Err.Description, vbCritical + vbOKOnly, "错误"
    Me.ProgressBar1.Value = 0
End Sub