外部链接新位置 VBA

Question

下面的代码非常适合在 vba 中刷新外部链接，但是有没有办法改变链接的位置？

我可以在勾选“始终提示新位置”时使用链接表管理器执行此操作，但我想通过 VBA 执行此操作，以便我可以创建一个按钮供用户按下以查找新工作簿

选择新工作簿，重新链接外部 Excel 工作簿。

Function Relink()

    Set db = CurrentDb
    Set tdf = db.TableDefs("Sales")
    tdf.Connect = "Excel 5.0;HDR=YES;IMEX=2;" & _
    "DATABASE=C:\Sales.xlsb"
    tdf.RefreshLink

End Function

Answer 1

我使用此功能从表中重新链接我的表，具体取决于我是在我的 c:\ 驱动器还是网络上工作。我认为您可以修改它以让用户输入文件位置，或使用文件对话框浏览到某个位置。

函数 relink_tables()

If Left(CurrentDb().Name, 2) = "C:" Then
    source = "local"
    Else: source = "network"
    End If
Set RS = CurrentDb.OpenRecordset("select * from [linked table source] where source='" & source & "'")
source = RS.Fields("path")

For Each R In References
    If InStr(R.Name, "Common Tables") > 0 Then Application.References.Remove R
    Next R
Application.References.AddFromFile source

x = 0
Set TDefs = CurrentDb().TableDefs
For Each table In TDefs
    If InStr(table.Connect, "Common Tables") = 0 Then GoTo NT
    table.Connect = ";DATABASE=" & source
    table.RefreshLink
    x = x + 1
NT:
    Next table
Finish:
MsgBox "remapped " & x & " tables"
End Function`enter code here`

Answer 2

这是我用来允许用户浏览到文件并选择它的函数。您可以调用此函数在之前的函数中获取文件名，而不是从表中获取。

Public Function Get_File(Optional ftype = "xls")

Dim fd As Object
Const msoFileDialogFolderPicker = 4
Const msoFileDialogFilePicker = 3
Const msoFileDialogViewDetails = 2

'Create a FileDialog object as a File Picker dialog box.
Set fd = Application.FileDialog(msoFileDialogFilePicker)
fd.AllowMultiSelect = False
fd.ButtonName = "Select"
fd.InitialView = msoFileDialogViewDetails
fd.Title = "Select File"
fd.InitialFileName = "MyDocuments\"
fd.Filters.Clear
fd.Filters.Add "Files", "*." & ftype & "*"

'Show the dialog box and get the file name
If fd.Show = -1 Then
    Get_File = fd.SelectedItems(1)
    Else
    Get_File = ""
    End If

End Function