VBA -Changing path of a linked table w/o deleting and relinking

[curtm]

At one time I had a simple routine that changed the location of a linked
table with out deleting and re-linking (refreshing.) I used it because I
didn't have to worry about losing permissions on that table once it was
deleted.

Can anyone help? I want to change the link from an Access database to a SQL
location.

Thanks

 

[Klatuu]

You can change location without deleting, but not without refreshing. Here
is a function that does exactly that

Private Function ReLink(strNewPath As String) As Boolean
Dim dbs As Database
Dim tdf As TableDef
Dim intCount As Integer
Dim frmCurrentForm As Form

DoCmd.Hourglass True
On Error GoTo ErrLinkUpExit
Me.lblMsg.Visible = True
Me.cmdOK.Enabled = False

Set dbs = CurrentDb

For intCount = 0 To dbs.TableDefs.Count - 1
Set tdf = dbs.TableDefs(intCount)
If tdf.Connect <> "" Then
Me.lblMsg.Caption = "Refreshing " & tdf.NAME
DoEvents
tdf.Connect = ";DATABASE=" & strNewPath
tdf.RefreshLink
End If ' tdf.Connect <> ""
Next intCount

Set dbs = Nothing
Set tdf = Nothing

DoCmd.Hourglass False
Me.lblMsg.Caption = "All Links were refreshed!"
ReLink = True
Me.cmdOK.Enabled = True
Exit Function

ErrLinkUpExit:
DoCmd.Hourglass False

Select Case Err
Case 3031 ' Password Protected
Me.lblMsg.Caption = "Back End '" & strNewPath & "'" & " is
password protected"
Case 3011 ' Table missing
DoCmd.Hourglass False
Me.lblMsg.Caption = "Back End does not contain required table '"
& tdf.SourceTableName & "'"
Case 3024 ' Back End not found
Me.lblMsg.Caption = "Back End Database '" & strNewPath & "'" & "
Not Found"
Case 3051 ' Access Denied
Me.lblMsg.Caption = "Access to '" & strNewPath & "' Denied" &
vbCrLf & _
"May be Network Security or Read Only Database"
Case 3027 ' Read Only
Me.lblMsg.Caption = "Back End '" & strNewPath & "'" & " is Read
Only"
Case 3044 ' Invalid Path
Me.lblMsg.Caption = strNewPath & " Is Not a Valid Path"
Case 3265
Me.lblMsg.Caption = "Table '" & tdf.NAME & "'" & _
" Not Found in ' " & strNewPath & "'"
Case 3321 ' Nothing Entered
Me.lblMsg.Caption = "No Database Name Entered"
Case Else
Me.lblMsg.Caption = "Uncaptured Error " & str(Err) &
Err.DESCRIPTION
End Select

Set tdf = Nothing
ReLink = False

End Functio