Ανανέωση ιστοσελίδας

[ggreg75]

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

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

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

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

Γρηγόρης

[pctechdr]

Για δοκίμασε αυτό!
RelinkAccessTables.zip

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

[γιώργοςΚ]

καλησπέρα,

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

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

[pctechdr]

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

[ggreg75]

Χρήστο,

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

Table_Name
Old_Path
New_Path

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

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

[pctechdr]

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

[ggreg75]

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

[ggreg75]

Βρήκα στο διαδίκτυο τον κάτωθι κώδικα και λειτουργεί μία χαρά για αρχεία 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]

Καλημέρα

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

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

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