尝试使用 VBA 在 Access DB 之间 link table。获取 ISAM 未找到错误
Trying to link table between Access DBs using VBA. Getting ISAM not found error
我有一个拆分数据库,前端和后端都是 accdb 文件。因为我的 table 之一使用 AppendOnly = Yes
属性,所以我无法使用 link table 管理器或刷新 link 属性 当我移动后端时。后端不时移动,因为我的 IT 喜欢重新调整服务器。
所以我的解决方案是编写一个函数,提示输入后端位置,删除所有当前 linked tables,然后循环遍历所有后端 tables link 将它们发送到前端。在这最后一部分,我收到一个 运行 时间错误 3170 找不到 suitable 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
属性.
时阻止刷新 links
在此先感谢您的帮助。
我认为您只是遗漏了字符串中的分号并删除了多余的空格
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;
我有一个拆分数据库,前端和后端都是 accdb 文件。因为我的 table 之一使用 AppendOnly = Yes
属性,所以我无法使用 link table 管理器或刷新 link 属性 当我移动后端时。后端不时移动,因为我的 IT 喜欢重新调整服务器。
所以我的解决方案是编写一个函数,提示输入后端位置,删除所有当前 linked tables,然后循环遍历所有后端 tables link 将它们发送到前端。在这最后一部分,我收到一个 运行 时间错误 3170 找不到 suitable 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
属性.
在此先感谢您的帮助。
我认为您只是遗漏了字符串中的分号并删除了多余的空格
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;