MS Access, связывание внутренних таблиц с использованием VB-кода через netowrk

Question

Я создал базу данных отслеживания для работы с интерфейсом переднего плана и таблицами бэкэнда.Прямо сейчас у меня есть фрагмент кода, который при запуске свяжет интерфейс с таблицами, чтобы люди могли скопировать и вставить интерфейс из «G: \ Sections \ MEO \ DDPO \ Active Issues \ Tracking Database» в свои базы данных.рабочего стола, и он по-прежнему будет иметь доступ к файлу бэкэнда.

Проблема, которую я хочу избежать, заключается в том, что если кто-то изменит путь к файлу, где расположен бэкенд, то передний конец не сможет найти бэкэнд,

пример:

Исходный путь G: \ Sections \ MEO \ DDPO \ Активные проблемы \ База данных отслеживания \ Бэкэнд базы данных \ tracking Database_be.accdb

Если кто-то изменил путь

G: \ New Sections \ MEO \ DDPO \ Активные проблемы \ База данных отслеживания \ База данных базы данных \ tracking Database_be.accdb

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

Private Function ReconnectTables() As Boolean
On Error Resume Next

Dim tdf As DAO.TableDef
Dim dbs As DAO.Database
Dim strPath As String
Dim strConnect As String

Set dbs = CurrentDb

strPath = dbs.Name

strPath = "G:\Sections\MEO\DDPO\Active Issues\Tracking Database\Database Backend\tracking Database_be.accdb"

strConnect = strPath

For Each tdf In dbs.TableDefs
    If tdf.Connect <> "" Then
        tdf.Connect = ";DATABASE=" & strConnect
        tdf.RefreshLink
    End If
Next

Set dbs = Nothing
If Err.Number = 0 Then ReconnectTables = True

End Function

Спасибо за любую помощь, которую вы можете оказать

Манро

Answer 1

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

Мой новый код выглядит следующим образом:

Private Function ReconnectTables() As Boolean
On Error Resume Next

Dim tdf As DAO.TableDef
Dim dbs As DAO.Database
Dim strPath As String
Dim strConnect As String

Set dbs = CurrentDb

strPath = dbs.Name

strPath = me.BackEndPath.Value

strConnect = strPath

For Each tdf In dbs.TableDefs
    If tdf.Connect <> "" Then
        tdf.Connect = ";DATABASE=" & strConnect
        tdf.RefreshLink
    End If
Next

Set dbs = Nothing
If Err.Number = 0 Then ReconnectTables = True

End Function

Раньше у меня просто было окно сообщения, которое появлялось, если таблицы не были связаны, но теперь я добавил 2 строки кода, чтобы открыть форму (frmBEpath), если таблицы не связаны.

Private Sub Form_Load()


 On Error Resume Next

'DoCmd.ShowToolbar "Ribbon", acToolbarNo

If ReconnectTables() = True Then
    strVerClient = Nz(DLookup("[VersionNumber]", "[tblVersionClient]"), "")
    strVerServer = Nz(DLookup("[VersionNumber]", "[tblVersionServer]"), "")
    Me.Repaint
Else
    'MsgBox "Couldn't Find Data Tables.  Exiting.", vbCritical, "Error"
   DoCmd.Close
   DoCmd.OpenForm "frmBEpath"
End If

End Sub

Эта новая форма сообщает пользователю о том, что таблицы не связаны, и дает им кнопку для просмотра внутренних файлов.Когда они выбирают бэкэнд-файл и нажимают кнопку «да», он сохраняет имя пути в таблице.

Option Compare Database

Public Function FolderSelection() As String
Dim objFD As Object
Dim strOut As String

strOut = vbNullString
Set objFD = Application.FileDialog(3)
If objFD.Show = -1 Then
    strOut = objFD.SelectedItems(1)
End If
Set objFD = Nothing
FolderSelection = strOut
End Function

Private Sub btnBrowse_Click()
Dim strChoice As String
strChoice = FolderSelection
If Len(strChoice) > 0 Then
    Me.txtPath = strChoice
End If
End Sub


Private Sub btnConfirmYes_Click()
Me.BackEndPath.Value = Me.txtPath.Value
DoCmd.Close
DoCmd.OpenForm "frmsplash"

End Sub