[ Πίνακες ] Αντιγραφή πινάκων από τρέχουσα βάση σε νέα βάση

[apostolos]

Καλησπέρα σας,

Θέλω τη βοήθεια σας στο εξής θέμα που με απασχολεί:
Έχω μια βάση δεδομένων και θέλω μέσω λειτουργικού κουμπιού φόρμας να αντιγράφονται μόνο οι πίνακες της βάσης σε νέα βάση που να δημιουργείτε εκείνη τη στιγμή.

Σας ευχαριστώ

[kapetang]

Καλησπέρα στην παρέα

Απόστολε, στη ΒΔ που επισυνάπτω , αν κάνουμε κλικ στο κουμπί της φόρμας « frmCreateDB», δημιουργείται μία νέα ΒΔ και ακολούθως αντιγράφονται σ’ αυτήν οι πίνακες της τρέχουσας.
Η λειτουργικότητα του κουμπιού, οφείλεται στον κώδικα:

Private Sub cmdCreateDB_Click()

    Dim ws As Workspace
    Dim db As Database
    Dim LFilename As String, dirName As String
    Dim Tbl As DAO.TableDef
    Dim x As Variant, j As Integer

    Set ws = DBEngine.Workspaces(0)

    'Διαδρομή και όνομα αρχείου (Να προσαρμοστεί στις ανάγκες)
    LFilename = "c:\Test\NewDB.mdb"
    
    'Αν δεν υπάρχει ο φάκελος, δημιουργείται
    x = Split(LFilename, "\")
    For j = LBound(x) To UBound(x) - 1
        If j = LBound(x) Then dirName = x(LBound(x)) Else dirName = dirName & "\" & x(j)
        If Dir(dirName, vbDirectory) = "" Then MkDir dirName
    Next
        

    'Αν υπάρχει το αρχείο διαγράφεται
    If Dir(LFilename) <> "" Then Kill LFilename

    'Δημιουργία νέου αρχείου *.mdb
    Set db = ws.CreateDatabase(LFilename, dbLangGeneral)
    
    'Αντιγραφή των πινάκων της τρέχουσας ΒΔ στη νέα
    For Each Tbl In CurrentDb.TableDefs
        If Left(Tbl.Name, 4) <> "MSys" Then
            DoCmd.TransferDatabase acExport, "Microsoft Access", LFilename, _
            acTable, Tbl.Name, Tbl.Name, False
        End If
    Next
    MsgBox "Η εξαγωγή των πινάκων ολοκληρώθηκε"
    db.Close
    Set db = Nothing

End Sub

Όπως βλέπεις στον κώδικα, το πλήρες όνομα της νέας βάσης είναι: "c:\Test\NewDB.mdb" Συνεπώς θα πρέπει να το προσαρμόσεις στις ανάγκες σου.
Δοκίμασε τον κώδικα, μήπως κάτι μου διέφυγε.

Φιλικά/Γιώργος

[kapetang]

Καλημέρα

Φίλε Απόστολε, πέρασαν αρκετές μέρες σιωπής.
Νομίζω ότι κάτι χρωστάς στο φόρουμ.
Δε θα έπρεπε να ενημερώσεις τα μέλη του, αν η βοήθεια που σου δόθηκε, ήταν αποτελεσματική ή όχι;

Γιώργος

[apostolos]

Η απάντηση με βρήκε στις διακοπές μου μόλις χθες επέστρεψα το δοκίμασα και λειτούργει τέλεια
Σας ευχαριστώ,

[SPHLIOS]

Καλησπέρα σε όλη τη παρέα. Πρωτα απ όλα σας ευχαριστώ όλους για την πολύτιμη βοήθειά σας. Παρακαλώ αν είναι εύκολο να μου εξηγήσετε πως γίνεται στο παραπάνω πρόγραμμα, μαζί με τους πίνακες να σώζει και τις σχέσεις τους .Ευχαριστώ και πάλι

[kapetang]

Καλησπέρα

Σπήλιο, δες τη συνημμένη ΒΔ.

Τροποποίησα λίγο τον παλιό κώδικα και πρόσθεσα και τη διαδικασία CopyRelations, ώστε στη νέα βάση, εκτός των πινάκων, να αντιγράφονται και οι σχέσεις τους.

Φιλικά/Γιώργος

[SPHLIOS]

Ευχαριστώ πάρα πολύ

[SPHLIOS]

Καλησπέρα σε όλη τη παρέα. Θα ήθελα να ρωτήσω τι πρέπει να αλλάξω στο παραπάνω παράδειγμα, αν αντί πινάκων έχω link των πινάκων, δηλαδη να πέρνω αντιγραφα των links αντι των πινάκων . Ευχαριστω

[kapetang]

Δοκίμασε τον κώδικα όπως είναι.

Αν συμβεί λάθος κατά την αντιγραφή των σχέσεων κάνε την εντολή:

copyRelations dbNew, dbCur σχόλιο.

[SPHLIOS]

Καλησπέρα, το πρόγραμμα δοκιμάστηκε και δεν δουλευει. Η εντολή που μου λές υπάρχει καΙ αντιγράφει τις σχέσεις. Εμένα με ενδιαφέρει να αντιγράφονται τα links των πινάκων. Ευχαριστώ