后台数据库连接出错

用重联函数试试

Function MyTrdb(Fname As String)
'功能：重建表链接。
'参数：Fname：后台数据库完整文件名
'示例：MyTrdb(CurrentProject.Path & "\后台数据库.mdb")
Dim obj As AccessObject, dbs As Object
Dim tbnmae As String
On Error GoTo MyTrdb_Err
    
Set dbs = Application.CurrentData
       For Each obj In dbs.AllTables
               tbnmae = obj.Name
               If InStr(obj.Name, "MSys") = 0 Then
                        DoCmd.DeleteObject acTable,tbnmae

                        DoCmd.TransferDatabase acLink, "Microsoft Access", Fname, acTable, tbnmae, tbnmae, False 
              End If
       Next obj

MyTrdb_Exit:
    Exit Function

MyTrdb_Err:
    MsgBox Error$
    Resume MyTrdb_Exit
End Function