[kapetang]

Καλημέρα

Γρηγόρη, αν όλα τα αρχεία σου (της ΒΔ, *.txt, Excel και των πινάκων) βρίσκονται στον ίδιο φάκελο, δοκίμασε τον κώδικα:

Public Sub UpdateLinks()
    'Ο κώδικας ισχύει για την περίπτωση που το αρχείο της ΒΔ
    'και τα αρχεία των συνδεδεμένων πινάκων, excel και *.txt
    'βρίσκονται στον ίδιο φάκελο
    '------------------------------------------------------------
    Dim db As DAO.Database, newPath As String, oldPath As String
    Dim m As Long, sFile As String, tbl As DAO.TableDef
    
    On Error GoTo errHandler
    
    Set db = CurrentDb
       
    For Each tbl In db.TableDefs
        If tbl.Connect <> "" Then
            oldPath = tbl.Connect
            If Left(oldPath, 4) = "Text" Then
                sFile = ""
            Else
                m = InStrRev(oldPath, "\")
                sFile = Mid(oldPath, m + 1)
            End If
            
            m = InStr(oldPath, "DATABASE")
            oldPath = Left(oldPath, m - 1) & "DATABASE="
            
            newPath = CurrentProject.FullName
            m = InStrRev(newPath, "\")
            newPath = Left(newPath, m)
            
            tbl.Connect = oldPath & newPath & sFile
            tbl.RefreshLink
        End If
    Next
    Exit Sub
errHandler:
    MsgBox Err.Description, vbCritical, "Error #" & Err.Number
End Sub