链接表管理器：需要 MS Access VBA 代码来更改 MS Excel 文件的文件位置

Question

我有一个 2013 MS Access 数据库，其中有多个用户位于不同的位置。我有几个 excel 文件作为链接表。 Excel 文件位于共享驱动器上，因此所有用户都可以访问该信息。我们遇到的问题是共享驱动器速度很慢，因此我们的报告需要很长时间才能加载。

我想要VBA代码，当用户打开数据库时，共享驱动器Excel文件会自动下载到他们的本地配置文件桌面。当然，每个用户配置文件都是不同的，因此链接表必须知道更改人员配置文件名称：“C：\ Users \”＆Environ（“用户名”）＆“\ Desktop \ Reports”。链接表管理器不允许 Environ(“用户名”)，因此必须在 VBA 中完成。

Answer 1

用于更改 Excel 工作表链接路径的代码。这需要已经建立与工作表的链接并且链接对象存在于数据库中。

Sub ChangeExcelLink()
Dim Tdf As DAO.TableDef
Dim Db As DAO.Database
Set Db = CurrentDb
Set Tdf = Db.TableDefs("link table name")
Tdf.Connect = "Excel 12.0;DATABASE=C:\Users\" & Environ("Username") & _
     "\Desktop\Reports\filename.xlsx;HDR=NO"
Tdf.RefreshLink
Set Tdf = Nothing
Set Db = Nothing
End Sub

如果工作表具有要保留的列标题，请将

HDR=No

更改为

HDR=Yes

或删除该参数，因为“是”是默认值。如果数据库需要密码，请使用

;PWD=yourpassword

。

Answer 2

很棒的 6 月 7 日。如果有正确的文件，它就会发挥作用。不过，有一个缺点：如果运行代码并且相关路径中不存在具有该名称的文件，（至少是我的）Access 2016 会生成某种具有该确切名称的虚拟文件，尽管该文件是一个xlsx 文件无法使用 Excel 打开，Access 也（当然）也无法创建指向文件中数据的链接。

我尝试进行错误清理：

Public Sub RelinkPicklist(selectedPath, selectedFile)

On Error GoTo errorHandling

Dim errMsg As String
Dim Tdf As DAO.TableDef
Dim Db As DAO.Database
Set Db = CurrentDb
Set Tdf = Db.TableDefs("pickliste")
Tdf.Connect = "Excel 12.0;DATABASE=" & selectedPath & selectedFile & ";HDR=NO"
Tdf.RefreshLink
Set Tdf = Nothing
Set Db = Nothing
Exit Sub

errorHandling:
    If Err = 3011 Then 'File not found, but a dummy file by that name is created by access that should be removed
        Kill selectedPath & selectedFile
        errMsg = "File " & selectedPath & selectedFile & " not found. Cleanup performed."
        MsgBox (errMsg)
    Else
        errMsg = "Error code: " & Err & ". Meaning rougly: " & Error(Err) & "."
        MsgBox (errMsg)
    End If
    Resume Next
    
End Sub

但是，创建的文件并没有被上面的代码删除，可能是因为 Access 仍然有它的句柄。我能看到的唯一解决方案是在尝试链接和刷新之前先行检查文件是否存在。这应该不是什么大问题。