Попытка связать таблицу между БД доступа, используя VBA. При получении ISAM не найдена ошибка

У меня есть разделенная база данных, где как передний, так и внутренний конец являются файлами accdb. Потому что одна из моих таблиц использует AppendOnly = Yes Я не могу использовать менеджер таблиц ссылок или свойство refreshlink при перемещении серверной части. Бэкенд время от времени перемещается, потому что мои ИТ любят переставлять серверы.

Поэтому мое решение - написать функцию, которая запрашивает местоположение бэкэнда, удаляет все связанные в данный момент таблицы, а затем перебирает все бэкэнд-таблицы и связывает их с внешним интерфейсом. В этой последней части я получаю сообщение об ошибке 3170 не удалось найти подходящий ISAM. Я не знаю почему.

Код ниже:

Public Function MoveDB()

'this function will replace the linked table manager.  It will open a file select dialog box to allow the user to pick the new location of the DB backend.
'It will then break all the current links and then recreate them.  We need to do this vice use the relink function because the cases table uses AutoAppend which stores old path data
' and breaks the relink function which is why linked table manager does not work.

' FileDialog Requires a reference to Microsoft Office 11.0 Object Library.

'variables to get the database path
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Dim DriveLetter As String
Dim NetworkPath As String
Dim DrivePath As String
Dim SubPath As String


'variables to link the database
Dim db As DAO.Database
Dim BEdb As DAO.Database
Dim oldtdf As DAO.TableDef
Dim tblName As String
Dim newtdf As DAO.TableDef
Dim BEtdf As DAO.TableDef


Set db = CurrentDb()

' Set up the File Dialog.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog

   ' Do not Allow user to make multiple selections in dialog box
  .AllowMultiSelect = False

  'set the default folder that is opened
  .InitialFileName = CurrentProject.Path & "\BE"

  ' Set the title of the dialog box.
  .Title = "Please select the Database Backend"

  ' Clear out the current filters, and add our own.
  .Filters.Clear
  .Filters.Add "Access Databases", "*.accdb"

  ' Show the dialog box. If the .Show method returns True, the
  ' user picked a file. If the .Show method returns
  ' False, the user clicked Cancel.
  If .Show = True Then

 'We need to determine the full network path (including server name) to the DB backend.  The reason is that different users may have the share drive mapped with different letters.
'If the backend is mapped using the drive letter of the user moving the DB then other users may not have a valid path.  The full network path is universal


'Get the mapped drive letter from the path of the selected DB file
     DriveLetter = Left$(Trim(fDialog.SelectedItems(1)), 2)
'Get the path of the selected DB file minus the drive letter
     SubPath = Mid$(Trim(fDialog.SelectedItems(1)), 3)
'Get the full network path of the mapped drive letter
     DrivePath = GETNETWORKPATH(DriveLetter)
'Combine the drive path and the sub path to get the full path to the selected DB file
     NetworkPath = DrivePath & SubPath
     'MsgBox (NetworkPath)
  Else
     MsgBox "You clicked Cancel in the file dialog box."
  End If
End With
     'Now we need to delete all the linked tables

For Each oldtdf In db.TableDefs
    With oldtdf
        If oldtdf.Attributes And dbAttachedODBC Or oldtdf.Attributes And dbAttachedTable Then
        'this is a linked table
            tblName = .Name
            DoCmd.DeleteObject acTable, tblName
        End If
    End With
Next oldtdf
tblName = ""


'Now we link all the tables from the backend to the front end
Set BEdb = OpenDatabase(NetworkPath)
For Each BEtdf In BEdb.TableDefs
    tblName = BEtdf.Name
    If Left(tblName, 4) <> "~TMP" Then
        Set newtdf = db.CreateTableDef(strTable)
        newtdf.Connect = "Database = " & NetworkPath
        newtdf.SourceTableName = tblName
        newtdf.Name = tblName
    db.TableDefs.Append newtdf
    End If
Next BEtdf

End Function

Ошибка возникает на

db.TableDefs.Append newtdf

линия. Я пытаюсь либо заставить этот код работать, либо обойти известную ошибку, которая препятствует обновлению ссылок при использовании AppendOnly=Yes имущество.

Заранее благодарю за любую помощь.

Источник

3 ответа

Решение

Я думаю, что вы просто пропустите точку с запятой в вашей строке и удалите лишние пробелы

newtdf.Connect = ";Database=" & NetworkPath
Источник

Кроме того, вы можете использовать метод DoCmd.TransferDatabase и не указывать таблицы MSys, так как они не используются напрямую между разделенными файлами:

If Left(tblName, 4) <> "~TMP" And Left(tblName, 4) <> "MSys" Then
     DoCmd.TransferDatabase acLink, "Microsoft Access", NetworkPath, _
                            acTable, tblName, tblName, False
End If
Источник

нашел это и работал у меня

      DAODataSet.SQL.Text := 'SELECT * FROM Country IN "" ";DATABASE=C:\SIMPLE.MDB;PWD=MyPassword"';
DAODataSet.Open;
Источник
Другие вопросы по тегам