Forum - Πίνακες Αυτόματη Ανανέωση Πινάκων

Σελίδα 1 από 2

Εμφάνιση 40 μηνυμάτων αυτού του θέματος σε μία σελίδα

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/4597-aytomati-ananeosi-pinakon.html)

ggreg75

06-06-17 14:55

Αυτόματη Ανανέωση Πινάκων

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

Υπάρχει κάποιος τρόπος να γίνεται αυτόματη ανανέωση πινάκων (με κώδικα εννοείται) βάσει του φακέλου που βρίσκεται το βασικό αρχείο access;

Επειδή χρειάζεται να μεταφέρω συνεχώς τους φακέλους εντός των οποίων βρίσκονται, το βασικό αρχείο access αλλά και τα συνδεδεμένα αρχεία access, excel ή txt θα ήταν εξαιρετικά χρήσιμο αν θα μπορούσα να αποφεύγω συνέχεια την εκ νέου σύνδεση των εξωτερικών αρχείων (ένα - ένα) από την "διαχείριση συνδεδεμένων πινάκων" (λόγω αλλαγής τοποθεσίας του φακέλου).

Ευχαριστώ εκ των προτέρων

Γρηγόρης

pctechdr

07-06-17 22:12

1 Συνημμένο(α)

Για δοκίμασε αυτό!
Συνημμένο Αρχείο 8828

Ελπίζω να ξέρεις να το κάνεις εισαγωγή στην εφαρμογή σου!
Αν χρειαστείς κάτι εδώ είμαστε!

γιώργοςΚ

07-06-17 23:02

καλησπέρα,

Χρίστο αν έχεις την καλοσύνη μας εξηγείς λίγο περι τίνως πρόκυται και πως μπορεί να χρησιμοποιειθεί?

Ευχαριστώ εκ προτέρων

pctechdr

07-06-17 23:07

Κάνεις εισαγωγή το module απο μέσα απο την access (vba)
Το καλείς με fRefreshLinks()
Εδώ ορίζεις τον συνδεμένο πίνακα Set rst = dbs.OpenRecordset("Όνομα πινακα")
Εδώ το password αν έχει Set dbLink = DBEngine(0).OpenDatabase(strDBPath, False, False, "MS Access;PWD=το pasword σου")

ggreg75

08-06-17 18:29

Χρήστο,

Καταρχήν ευχαριστώ για την απάντησή σου.
Ο κώδικας που μου έχεις στείλει είναι πολύ σύνθετος, βγάζει σφάλμα και δεν μπορώ να βγάλω άκρη.
Θα ήθελα να απλοποιήσω λίγο την διαδικασία ως εξής :
Αν υποθέσουμε ότι έχουμε έναν πίνακα με την ονομασία "LinksTables" ο οποίος περιέχει 3 πεδία :

Table_Name
Old_Path
New_Path

Μπορεί να δημιουργηθεί ένας κώδικας σε VBA που να ενημερώσει για την νέα τοποθεσία των αρχείων;

Επίσης, με τον παραπάνω τρόπο μπορώ να έχω μεγαλύτερη ευελιξία καθώς μπορώ να επιλέξω ποιοι πίνακες θέλω να ανανεωθούν (μέσω του παραπάνω πίνακα) χωρίς να επεμβαίνω στον κώδικα.
Το πώς θα ενημερώνεται ο πίνακας «LinksTables» πριν γίνει η ανανέωση των πινάκων είναι κάτι που μπορώ να το κάνω.
*
Ευχαριστώ εκ των προτέρων
*
Γρηγόρης

pctechdr

08-06-17 23:02

http://www.ms-office.gr/forum/access...in-access.html

ggreg75

09-06-17 09:13

Καλημέρα. Το εν λόγω θέμα που μου έστειλες, δεν υποστηρίζει ανανέωση πινάκων με τον τρόπο που χρειάζομαι. Υποστηρίζει ανανέωση μόνο από ένα αρχείο mdb.

ggreg75

10-06-17 17:39

Βρήκα στο διαδίκτυο τον κάτωθι κώδικα και λειτουργεί μία χαρά για αρχεία mdb. Όχι όμως για αρχεία xls ή txt.
Μήπως θα μπορούσε κάποιος να με βοηθήσει για τα αρχεία xls ή txt;

Function SetTableLinkPath(strTableName As String, strTablePath As String)

If Nz(strTableName, "") <> "" And Nz(strTablePath, "") <> "" Then
Dim cdb As DAO.Database

Set cdb = CurrentDb

cdb.TableDefs(strTableName).Connect = ";DATABASE=" & strTablePath
cdb.TableDefs(strTableName).RefreshLink

MsgBox "Ο πίνακας " & strTableName & " ανανεώθηκε με την νέα τοποθεσία : " & strTablePath & "."
Else
MsgBox "You must enter a valid Table path and name!"
End If

End Function

kapetang

11-06-17 08:42

Καλημέρα

Γρηγόρη, αν όλα τα αρχεία σου (της ΒΔ, *.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

ggreg75

11-06-17 10:55

Γιώργο καλημέρα,
Δουλεύει μία χαρά!

Ευχαριστώ πάρα πολύ για την πολύτιμη βοήθειά σου!

Η ώρα είναι 16:59.

Σελίδα 1 από 2

Εμφάνιση 40 μηνυμάτων αυτού του θέματος σε μία σελίδα

Search Engine Optimization by vBSEO 3.3.2