Sub RefreshLink()
On Error GoTo RefreshLink_Err
Dim cat As ADOX.Catalog
Dim tdf As ADOX.Table
Dim strNewLocation As String
Dim strTemp As String
Set cat = New ADOX.Catalog
Set cat.ActiveConnection = CurrentProject.Connection
Set tdf = cat.Tables("Employees")
strTemp = tdf.Columns(0).Name
Exit Sub
RefreshLink_Err:
strNewLocation = InputBox("Please Enter Database Path and Name")
tdf.Properties("Jet OLEDB:Link Datasource") = _
strNewLocation
Set cat.ActiveConnection = CurrentProject.Connection
Set tdf = cat.Tables("Employees")
Resume
End Sub
|