Question

我有5-6个客户，我将销售基于Access的产品。哪里有后端数据库文件（密码保护）。访问accdr前端文件，将数据保存在后端文件中。后端文件的位置将客户端更改为客户端，因此希望有一个链接前端t后端的VBA代码。

我尝试了以下代码

sConnect = "Provider=Microsoft.ACE.OLEDB.12.0; " _ 
    & Data Source= " & "C:\MyDB_be.accdb" & ";" _ 
    & "Jet OLEDB:Database Password=123;"

但是，表格没有重新连接。

我从this Ques on Stackoverflow获得了上述代码。

然后我尝试了下面的代码

Const LnkDataBase = "C:\MyDB_be.accdb"
Sub relinktables()
'Routine to relink the tables automatically. Change the constant LnkDataBase to the desired one and run the sub
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim strTable As String
Set dbs = CurrentDb()
For Each tdf In dbs.TableDefs
    If Len(tdf.Connect) > 1 Then 'Only relink linked tables
        If tdf.Connect <> ";DATABASE=" & LnkDataBase Then 'only relink tables if the are not linked right
            If Left(tdf.Connect, 4) <> "ODBC" Then 'Don't want to relink any ODBC tables
                strTable = tdf.Name
                dbs.TableDefs(strTable).Connect = ";DATABASE=" & LnkDataBase
                dbs.TableDefs(strTable).RefreshLink
            End If
        End If
    End If
Next tdf
End Sub

当文件没有密码保护时，这是有效的。这段代码来自This Ques。但是没有规定密码的规定。

请帮帮我。

要么指出第一个代码中的错误。或者如何指定密码第二个代码或新代码。

花了4个小时寻找解决方案。新访问VBA。

经过this和this，但不明白如何实施。

Answer 1

尝试一下：

Const LnkDataBase = "C:\MyDB_be.accdb"
Sub relinktables()
'Routine to relink the tables automatically. Change the constant LnkDataBase to the desired one and run the sub
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim strTable As String
Set dbs = CurrentDb()
For Each tdf In dbs.TableDefs
    If Len(tdf.Connect) > 1 Then 'Only relink linked tables
        If tdf.Connect <> ";DATABASE=" & LnkDataBase Then 'only relink tables if the are not linked right
            If Left(tdf.Connect, 4) <> "ODBC" Then 'Don't want to relink any ODBC tables
                strTable = tdf.Name
                dbs.TableDefs(strTable).Connect = "Provider=Microsoft.ACE.OLEDB.12.0; " _ 
& "Data Source= " & LnkDataBase & ";" _ 
& "Jet OLEDB:Database Password=123;"
                dbs.TableDefs(strTable).RefreshLink
            End If
        End If
    End If
Next tdf
End Sub

Answer 2

投资另外4小时后，这个问题。终于找到了解决方案。

这是完美无瑕的代码。

Const LnkDataBase = "C:\MyDB_be.accdb"
Const DBPassword = "123"

Sub relinktables()
'Routine to relink the tables automatically. Change the constant LnkDataBase to the desired one and run the sub
Dim dbs As DAO.Database
Dim tdf As DAO.TableDef
Dim strTable As String
Set dbs = CurrentDb()
For Each tdf In dbs.TableDefs
    If Len(tdf.Connect) > 1 Then 'Only relink linked tables
        If tdf.Connect <> ";DATABASE=" & LnkDataBase Then 'only relink tables if the are not linked right
            If Left(tdf.Connect, 4) <> "ODBC" Then 'Don't want to relink any ODBC tables
                strTable = tdf.Name
                dbs.TableDefs(strTable).Connect = "MS Access;PWD=" & DBPassword & ";DATABASE=" & LnkDataBase
                dbs.TableDefs(strTable).RefreshLink
            End If
        End If
    End If
Next tdf
End Sub

我会鼓励VBA专家添加他们的意见或修改此代码以添加错误调试。类似 - 如果PC没有连接到网络，并且指定的路径在网络上，则Access挂起。这个问题尚待解决。

使用VBA

2 个答案: