找了一天,今天终于把这个问题解决了,网上找到的如下:
Private Sub Command3_Click()
On Error GoTo ErrHandle
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim strCon As String
Dim strBackEnd As String
Dim strMsg As String
Dim aaa As String
Dim intErrorCount As Integer
Set db = CurrentDb
aaa = Me.patha
For Each tdf In db.TableDefs
If Left$(tdf.Connect, 4) = "ODBC" Then
strCon = Nz(tdf.Connect, "")
' Debug.Print tdf.Connect
strBackEnd = Right$(strCon, (Len(strCon) - (InStrRev(strCon, "SourceType") - 1)))
' 狦籓戈畐Τ
' Debug.Print strBackEnd
If Len(strBackEnd & "") > 0 Then
Set tdf = db.TableDefs(tdf.NAME)
tdf.Connect = "ODBC;DSN=foxpro;SourceDB=" & aaa & ";" & strBackEnd
tdf.RefreshLink
' DoCmd.RunSQL "Create UNIQUE index hwck_sb on 123 ([sb_ym],[sb_no])"
Else
intErrorCount = intErrorCount + 1
strMsg = strMsg & "Error getting back-end database name." & vbNewLine
strMsg = strMsg & "Table Name: " & tdf.NAME & vbNewLine
strMsg = strMsg & "Connect = " & strCon & vbNewLine
End If
End If
Next tdf
ExitHere:
On Error Resume Next
If intErrorCount > 0 Then
strMsg = "There were errors refreshing the table links: " _
& vbNewLine & strMsg & "In Procedure RefreshTableLinks"
RefreshTableLinks = strMsg
End If
Set tdf = Nothing
Set db = Nothing
Exit Sub
ErrHandle:
intErrorCount = intErrorCount + 1
strMsg = strMsg & "Error " & Err.Number & " " & Err.Description
strMsg = strMsg & vbNewLine & "Table Name: " & tdf.NAME & vbNewLine
strMsg = strMsg & "Connect = " & strCon & vbNewLine
MsgBox strMsg, vbCritical
Resume ExitHere
End Sub
