Пересвязать внутреннюю базу данных с внешней формы доступа с помощью VBA - PullRequest
Новая
       5

Пересвязать внутреннюю базу данных с внешней формы доступа с помощью VBA

0 голосов
/ 22 ноября 2018

База данных My Access разделена на заднюю и внешнюю.Я создал форму доступа во внешнем интерфейсе, которая содержит текстовое поле, кнопку Браузер и кнопку Relink .

Когда я нажимаю Просмотр , появляется файловый менеджер, чтобы выбрать мой файл .mdb.После того, как файл выбран, путь к файлу отображается в textBox.

То, что я хочу, это когда я нажимаю кнопку Relink , он должен взять путь из textBox и связать мою спинуКонец файла в мой интерфейс.

Вот мой код: 

'browse button
 Private Sub browseBtn_Click()
   Dim objDialog As Object
   set objDialog = Application.FileDialog(3)
   With objDialog
        .show
        .AllowMultiSelect = False
        If .SelectedItems.Count = 1 Then
            'textFiled displays the path
             Me.textField = .SelectedItems(1) 
        End If
    End With
 End Sub

'relink button
Private Sub linkBtn_Click()
    Dim newConnection As String
    Dim currentPath As String
    currentPath = Me.textField
    Dim tblDef As TableDef
        tblDef.Connect = newConnection
        tblDef.RefreshLink
End Sub

Что с этим не так?

1 Ответ

0 голосов
/ 22 ноября 2018

Я в конце разобрался, вот полный код: 

Private Sub browseBtn_Click()
Dim objDialog As Object

 Set objDialog = Application.FileDialog(3)

 With objDialog
   .title = "Please select the backend file"
   .AllowMultiSelect = False
   .Show
   If .SelectedItems.Count = 1 Then
    Me.textField = .SelectedItems(1)
   End If
 End With
End Sub

Private Sub linkBtn_Click()
  RefreshLinks (Me.textField)
End Sub


Public Function RefreshLinks(strFilename As String)
   Dim dbs As dao.Database
   Dim tdf As TableDef

   Set dbs = CurrentDb

    For Each tdf In dbs.TableDefs
         If Len(tdf.Connect) > 0 Then
             tdf.Connect = ";DATABASE=" & strFilename
             Err = 0
            On Error Resume Next
            tdf.refreshlink
             If Err <> 0 Then
                RefreshLinks = False
                 Exit Function
             End If
         End If
    Next tdf
    RefreshLinks = True

End Function
...