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