外部 link 新位置 VBA

Question

下面的代码非常适合刷新 vba 中的外部 link 但是有没有办法更改 link 的位置？

我可以在勾选 'Always prompt for new location' 时使用 linked table 管理器执行此操作，但我想通过 VBA 执行此操作，以便我可以创建供用户按下以定位新工作簿的按钮

Select 新工作簿，Relink 外部 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

我使用此功能从 table 重新 link 我的 table，这取决于我是在我的 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

这是我用来允许用户浏览到文件并 select 的功能。您可以调用此函数以在先前的函数中获取文件名，而不是从 table.

中获取文件名

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

外部 link 新位置 VBA

External link new location VBA

ms-access

vba

ms-access-2010