S
Stephen Wyeth (DHL GB)
Using Access 2000 I need to relink attached tables when deploying an
application. When attempting to relink the tables with code I get
"Could Not Find Installable ISAM" error. I have followed Microsoft
article 209805 and re-registered the DLLs but still no joy.
I have used the following code successfully before:
Public Function GetNamePath() As String
On Error GoTo GetNamePath_Err
Dim MyDB As Database
Dim strPath As String
Dim intBackSlash As Integer
Dim intLoop As Integer
' Set MyDB to the current database.
Set MyDB = CurrentDb()
' Return the value in the Name property.
strPath = MyDB.Name
For intLoop = 1 To Len(strPath)
If Mid(strPath, intLoop, 1) = "\" Then intBackSlash = intLoop
Next intLoop
GetNamePath = Left(strPath, intBackSlash)
MyDB.Close
Set MyDB = Nothing
GetNamePath_Exit:
Exit Function
GetNamePath_Err:
errmsg.Show Err.Number, Err.Description, "Module - basGlobal",
"Function - GetNamePath"
Resume GetNamePath_Exit
End Function
Public Function ReLinkData()
Dim strNewPath As String
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim strsql As String
Dim rst As DAO.Recordset
Dim strLink As String
Set db = DBEngine(0)(0)
strNewPath = GetNamePath
strsql = "SELECT * FROM MSysObjects WHERE Type = 6"
Set rst = db.OpenRecordset(strsql, dbOpenSnapshot)
With rst
If !Database = strNewPath Then
'Do not relink tables
MsgBox "Tables linked to correct file"
Else
'Relink tables
For Each tdf In db.TableDefs
strLink = "DATABASE=" & strNewPath & "ICEData.mdb;TABLE=" &
tdf.Name
tdf.Connect = strLink
tdf.RefreshLink
Next tdf
End If
End With
End Function
Any help would be appreciated.
Steve
application. When attempting to relink the tables with code I get
"Could Not Find Installable ISAM" error. I have followed Microsoft
article 209805 and re-registered the DLLs but still no joy.
I have used the following code successfully before:
Public Function GetNamePath() As String
On Error GoTo GetNamePath_Err
Dim MyDB As Database
Dim strPath As String
Dim intBackSlash As Integer
Dim intLoop As Integer
' Set MyDB to the current database.
Set MyDB = CurrentDb()
' Return the value in the Name property.
strPath = MyDB.Name
For intLoop = 1 To Len(strPath)
If Mid(strPath, intLoop, 1) = "\" Then intBackSlash = intLoop
Next intLoop
GetNamePath = Left(strPath, intBackSlash)
MyDB.Close
Set MyDB = Nothing
GetNamePath_Exit:
Exit Function
GetNamePath_Err:
errmsg.Show Err.Number, Err.Description, "Module - basGlobal",
"Function - GetNamePath"
Resume GetNamePath_Exit
End Function
Public Function ReLinkData()
Dim strNewPath As String
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim strsql As String
Dim rst As DAO.Recordset
Dim strLink As String
Set db = DBEngine(0)(0)
strNewPath = GetNamePath
strsql = "SELECT * FROM MSysObjects WHERE Type = 6"
Set rst = db.OpenRecordset(strsql, dbOpenSnapshot)
With rst
If !Database = strNewPath Then
'Do not relink tables
MsgBox "Tables linked to correct file"
Else
'Relink tables
For Each tdf In db.TableDefs
strLink = "DATABASE=" & strNewPath & "ICEData.mdb;TABLE=" &
tdf.Name
tdf.Connect = strLink
tdf.RefreshLink
Next tdf
End If
End With
End Function
Any help would be appreciated.
Steve