VB使用DAO控制ACCESS链接表!

在一家使用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

转载于:https://www.cnblogs.com/fxwdl/archive/2006/08/08/471302.html