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

外部链接新位置VBA

2 个答案: