Function Relink2()
Dim Db As Database
Dim Tdf As TableDef
Dim SQL As String
Dim Rs As Recordset
Dim Rst As Recordset
Dim ImeTabele As String
Dim Putanja As String
Dim PutanjaORg As String
Dim Link As Boolean
Dim R

On Error Resume Next
Set Db = CurrentDb
SQL = "SELECT Name FROM MSysObjects WHERE Database<>Null"
Set Rs = Db.OpenRecordset(SQL)
Do While Not Rs.EOF
ImeTabele = Rs!Name
Set Rst = Db.OpenRecordset("SELECT * FROM " & ImeTabele & " WHERE False<>False")
Rst.Close
    If err.Number > 0 Then
    MsgBox "Nema konekcije na baze"
    Link = False
    err = 0
    Rs.Close
    GoTo RELINK_TABELA
    End If
Rs.MoveNext
Loop
Rs.Close
Exit Function
RELINK_TABELA:
SQL = "SELECT Database,Name FROM MSysObjects WHERE Database<>Null ORDER By Database"
Set Rs = Db.OpenRecordset(SQL)

Do While Not Rs.EOF
ImeTabele = Rs!Name
Putanja = Rs!Database
START_LINK:
If Link = False Then
Dim iResponse As String
R = MsgBox("Vjerovatno putanja nije ispravna." & vbCrLf _
& "Želiš li odabrati novu putanj za tabelu: " & ImeTabele & "?  ", _
vbOKCancel + vbInformation + vbApplicationModal + vbDefaultButton1, _
Putanja)
    If R = vbOK Then
    PutanjaORg = NadjiBazu("")
    Else
    Quit
    End If
End If
Set Tdf = Db.TableDefs(ImeTabele)
Tdf.Connect = ";DATABASE=" & PutanjaORg
err = 0
Tdf.RefreshLink
    If err <> 0 Then
    Link = False
    GoTo START_LINK
    Else
    Link = True
    End If
Rs.MoveNext
Loop
End Function