Εντοπισμός αρχείου συνδεδεμένων πινάκων μέσα από την εφαρμογή μου

[kasampas]

Καλημέρα και καλή χρόνιά
Έχω φτιάξει μια εφαρμογή της οποία οι πίνακες με τα δεδομένα βρίσκονται στην DB1 και όλα τα υπόλοια (διασύνδεση, ερωτήματα κ.τ.λ) στην DB2, με σύνδεση των πινάκων.
Αν την DB1 την βάλω σε άλλο φάκελο, η DB2 δεν μπορει να εντοπίσει τους πίνακες (λογικό θα πει κανεις).
Πώς μπορώ μέσω της DB2 (με κώδικα ή με καποιον άλλο τροπο;;) να εντοπίζω τη διαδαρομή της DB1 και να επανσυνδένται οι πίνακες;
π.χ. μέσω μιας φόρμας να δίνω το νέο path και το όνομα αρχείου και με τον κατάλληλο κώδικα να επανασυνδέονται οι πίνακες, χωρίς να χρησιμοποιώ το περιβάλλον και τα εργαλεία της access.
Υ.Γ. Μπορεί να συμβεί κάτι τέτοιο;

[kapetang]

Καλησπέρα

Βαγγέλη θα μπορούσες να προσθέσεις στη ΒΔ (DB2) μία φόρμα με ένα κουμπί και να χρησιμοποιήσεις τον παρακάτω κώδικα:

Private Sub cmdUpadateLinks_Click()
    Dim fullNameDB As String
    fullNameDB = PickDB()
    If Len(fullNameDB) > 0 Then
        UpdateLinks (fullNameDB)
    End If
End Sub

Public Function PickDB() As String
'Απαιτείται αναφορά στην Microsoft Office Object Library.
'Έκδοσης >=11.0

    With Application.FileDialog(3)

        'Επιλέγεται μόνο ένα αρχείο
        .AllowMultiSelect = False

        'Τίτλος του dialog box.
        .Title = "Διαλέξτε μία ΒΔ"

        'Ορισμός νέων φίλτρων.
        .Filters.Clear
        .Filters.Add "Access Databases", "*.MDB;*.accdb"
        .Filters.Add "Access Projects", "*.ADP"
        .Filters.Add "All Files", "*.*"

        'εμφάνιση πλαισίου διαλόγου και επιλογή
        If .Show = True Then
            PickDB = .SelectedItems(1)
        End If
        
    End With
End Function

Public Sub UpdateLinks(strBackEnd As String)
    'Ο κώδικας ισχύει για την περίπτωση που όλοι οι πίνακες
    'με τους οποίους συνδέεται η τρέχουσα ΒΔ βρίσκονται
    'σε μια ΒΔ (strBackEnd)
    '------------------------------------------------------------
    Dim db As DAO.Database, tbl As DAO.TableDef
    
    On Error GoTo errHandler
    
    Set db = CurrentDb
       
    For Each tbl In db.TableDefs
        If tbl.Connect <> "" Then
            tbl.Connect = ";DATABASE=" & strBackEnd
            tbl.RefreshLink
        End If
    Next
    
    MsgBox ("Οι σύνδεσμοι ενημερώθηκαν.")
    Exit Sub
errHandler:
    MsgBox Err.Description, vbCritical, "Error #" & Err.Number
End Sub

Σημειώνω ότι ο κώδικας θα πρέπει να αντιγραφεί στη φόρμα και ότι ονόμασα το κουμπί cmdUpadateLinks

Πατώντας το κουμπί θα εμφανιστεί ένα πλαίσιο διαλόγου επιλογής αρχείων, για να επιλέξουμε τη ΒΔ με τους πίνακες δεδομένων.

[pctechdr]

Βάλε αυτό μέσα στο FE της εφαρμογής σου και είσαι έτοιμος!! Απο την visual basic καρτέλα κάνε εισαγωγή το module που σου έχω στο συμπιεσμένο αρχείο.
basJStreetAccessRelinker.zip
Ξέχασα να σου πω να δημιουργήσεις μια μακροεντολή που θα την ονομάσεις AutoExec (αν δεν έχεις ήδη) και να προσθέσεις αυτό.
RunCode
jstCheckTableLinks_Quick()

[kasampas]

Ευχαριστώ πολύ
Εξαιρετικό!!!