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

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

0 голосов
/ 05 января 2019

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

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

Сохраненные данные InputFolder выглядят так: C: \ Users \ CXB028 \ OneDrive - Comerica \ Проекты \ HR \ Входные данные

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

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

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 при переопределении новой входной папки.

1 Ответ

0 голосов
/ 11 января 2019

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

 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

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

...