Relink Table

[Rob Parker]

I'm using the code listed below to re-establish a link to a spreadsheet.
It's based on the code at http://www.mvps.org/access/tables/tbl0012.htm, but
it fails to reset the connection string. The existing connect string is:
Excel 5.0;HDR=YES;IMEX=2;DATABASE=C:\Documents and Settings\Rob\My
Documents\zzzDocument Index - New.xls
and the new connect string, generated from the selected filename, is either:
Excel 5.0;HDR=YES;IMEX=2;DATABASE=C:\Documents and Settings\Rob\My
Documents\Document Index - New.xls
or
Excel 5.0;HDR=YES;IMEX=2;DATABASE="C:\Documents and Settings\Rob\My
Documents\Document Index - New.xls"
or
;DATABASE=C:\Documents and Settings\Rob\My Documents\Document Index -
New.xls
or
;DATABASE="C:\Documents and Settings\Rob\My Documents\Document Index -
New.xls"

I tried the versions with quote delimiters to see whether the spaces in the
filename were causing the problem, and the shorter versions (starting with
;DATABASE = ) when the first two failed to work, thinking that perhaps I
didn't need the first portion (the MSysObjects has the "Excel
5.0;HDR=YES;IMEX=2;" in the Connect field, and the full filename in the
database field). However, none of these reset the link - the relevant lines
of code:
CurrentDb.TableDefs(strTableName).Connect = strNewConnect
CurrentDb.TableDefs(strTableName).RefreshLink
seem to do nothing; after the code runs, the connect string is unchanged
from its initial value.

What am I missing here?

TIA,

Rob


Public Function RelinkSheet(strTableName As String) As Boolean
Dim tdf As DAO.TableDef
Dim strFilter As String
Dim strXLS As String
Dim strSheet As String
Dim strOldPath As String
Dim strNewConnect As String
Dim iStart As Integer
Dim iLength As Integer

On Error GoTo RelinkSheet_Error

strSheet = Left(CurrentDb.TableDefs(strTableName).SourceTableName,
Len(CurrentDb.TableDefs(strTableName).SourceTableName) - 1)
Debug.Print strSheet
Debug.Print CurrentDb.TableDefs(strTableName).Connect
iStart = InStr(1, CurrentDb.TableDefs(strTableName).Connect, "DATABASE=")
+ 9
iLength = Len(CurrentDb.TableDefs(strTableName).Connect) - 9
strOldPath = Mid(CurrentDb.TableDefs(strTableName).Connect, iStart,
iLength)
strOldPath = Left(strOldPath, InStrRev(strOldPath, "\"))
' Debug.Print strOldPath
RelinkSheet = False
strFilter = ahtAddFilterItem(strFilter, "Excel Files (*.XLS)", "*.XLS")
strXLS = ahtCommonFileOpenSave( _
Filter:=strFilter, OpenFile:=True, _
InitialDir:=strOldPath, _
DialogTitle:="Please select the Document Index file...", _
Flags:=ahtOFN_HIDEREADONLY)
' Debug.Print strXLS
If strXLS <> "NoFile" Then
'strNewConnect = Left(CurrentDb.TableDefs(strTableName).Connect,
iStart - 1) & strXLS
'strNewConnect = Left(CurrentDb.TableDefs(strTableName).Connect,
iStart - 1) & """" & strXLS & """"
'strNewConnect = ";DATABASE=" & strXLS
strNewConnect = ";DATABASE=" & """" & strXLS & """"
Debug.Print "strNewConnect = " & strNewConnect
CurrentDb.TableDefs(strTableName).Connect = strNewConnect
CurrentDb.TableDefs(strTableName).RefreshLink
Debug.Print "Connect set to " &
CurrentDb.TableDefs(strTableName).Connect
End If
'use custom function to check that new link is valid
If CheckLink(strTableName) Then
RelinkSheet = True
Else
RelinkSheet = False
End If

ExitPoint:
Debug.Print RelinkSheet
Set tdf = Nothing
Exit Function

RelinkSheet_Error:
RelinkSheet = False
If Err.Number = 3011 Then
MsgBox "The file you selected does not contain the '" & strSheet & "'
sheet.", vbExclamation, "Sheet Not Found"
Resume ExitPoint
End If
MsgBox "Error " & Err.Number & " (" & Err.Description & ")" & vbNewLine _
& "in procedure RelinkSheet" & vbNewLine _
& "of Module RefreshLinks"
Resume ExitPoint

End Function

 

[Rob Parker]

Problem solved.

I got it to work by actually using the tdf variable which I had defined, but
wasn't using (instead, I was always using
"CurrentDb.TableDefs(strTableName). ...")

So now my code contains:
...
Dim db As DAO.Database
Dim tdf As DAO.TableDef

Set db = CurrentDb
Set tdf = db.TableDefs(strTableName)
...
strNewConnect = Left(tdf.Connect, iStart - 1) & strXLS
tdf.Connect = strNewConnect
tdf.RefreshLink
...
and all works fine.

And a couple of other things:
1. If I use "Set db = dbEngine (0) (0)", rather than "Set db = CurrentDb",
the tdf.connect string does not contain the initial connect parameters (eg.
"Excel 5.0;HDR=YES;IMEX=2"), it only contains the bit starting with
";DATABASE=". The full string is required when to set the link to a
spreadsheet.

2. Delimiting the filename with quote characters is not required, and
generates an error.


Rob

now letting bruising to head subside, and removing marks from wall ;-)