Используйте код VBA для обновления ссылок на внешние источники данных

Question

Я ищу использовать VBA для обновления ссылок для внешнего входного файла. Я разработчик, и путь к связанному входному файлу, который я использую, не будет таким же, как конечному пользователю, когда он будет помещен в рабочую папку.

Есть ли способ обновить местоположение связанного файла с помощью VBA? У меня уже есть код, который позволяет пользователю указать местоположение входного файла, и эта информация сохраняется в [InputFolder] таблицы [Defaults]. Есть ли способ использовать VBA для обновления связанной таблицы, используя информацию о поле InputFolder?

Сохраненные данные InputFolder выглядят следующим образом: C:\Users\CXB028\OneDrive - Comerica\Projects\HR\Input Data

В новой информации о папке будет определен путь к сетевому диску, к которому у меня нет доступа, но у пользователя есть.

Вот код, который я использую для определения и сохранения местоположения папки ввода:

Private Sub btnInputFldr_Click()
On Error GoTo Err_Proc

Const msoFileDialogFolderPicker As Long = 4
Dim objfiledialog As Object
Dim otable As DAO.TableDef
Dim strPathFile As String, strFile As String, strpath As String
Dim strTable As String
Dim fldr As Object

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)

With fldr
    .Title = "Choose Folder"
    .Show
    .InitialFileName = "" 'DFirst("InputFolder", "Defaults")

        If .SelectedItems.Count = 0 Then

            Exit Sub

        Else
            CurrentDb.Execute "UPDATE Defaults SET InputFolder='" & .SelectedItems(1) & "';"

        End If

End With

Me.txtInputFldr.Requery

Exit Sub

Err_Proc:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Process Error"

End Sub

Связанную таблицу (внешнюю электронную таблицу Excel) необходимо повторно связать после перемещения базы данных в производственное местоположение с использованием кода VBA при переопределении новой входной папки.

Answer 1

Я нашел очень простой и короткий код, который работал отлично!! Пожалуйста, смотрите ниже.

 On Error Resume Next
 'Set new file path location if the TABLE.FIELDNAME location exists
 Set tbl = db.TableDefs("ENTER THE LINKED TABLE NAME HERE")
 filePath = DLookup("ENTER YOUR LOOKUP TABLE FIELD NAME HERE", "ENTER YOUR LOOKUP TABLE NAME HERE") & "\ENTER YOUR EXCEL SPREADSHEET NAME HERE.XLSX"
     tbl.Connect = "Excel 12.0 Xml;HDR=YES;IMEX=2;ACCDB=YES;DATABASE=" & filePath
     tbl.RefreshLink
 On Error GoTo 0

Надеюсь, кто-то найдет это полезным, как и я!