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/1239-antigrafi-pinakon-apo-trexoysa-basi-se-nea-basi.html)

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

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

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

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

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

Απόστολε, στη ΒΔ που επισυνάπτω , αν κάνουμε κλικ στο κουμπί της φόρμας « 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" Συνεπώς θα πρέπει να το προσαρμόσεις στις ανάγκες σου.
Δοκίμασε τον κώδικα, μήπως κάτι μου διέφυγε.

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

Καλημέρα

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

Γιώργος

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

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

Καλησπέρα

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

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

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

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

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

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

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

copyRelations dbNew, dbCur σχόλιο.

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