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

Forum (https://www.ms-office.gr/forum/)

- Access - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/)

- - Εντοπισμός αρχείου συνδεδεμένων πινάκων μέσα από την εφαρμογή μου (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/4803-entopismos-arxeioy-syndedemenon-pinakon-mesa-apo-tin-efarmogi-moy.html)

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

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

Καλησπέρα

Βαγγέλη θα μπορούσες να προσθέσεις στη ΒΔ (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

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

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

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