[Tasos]

Καλησπέρα σε όλους!

Αν στα πλαίσια κάποιου αυτοματισμού θέλουμε κάνουμε συμπύκνωση κι επιδιόρθωση με κώδικα από την ίδια βάση, χρησιμοποιούμε:

 Application.SetOption ("Auto Compact"),  True

Μ αυτό τον τρόπο ενεργοποιούμε την επιλογή Συμπύκνωση κατά το κλείσιμο.

Για να κάνουμε την ίδια ενέργεια σε άλλη βάση χρησιμοποιούμε την παρακάτω συνάρτηση:

  Function CompactDB(DbFullName$, Optional CompactPersentage%)
    Dim DbFile$, DbPath, tmpFullName, AppCompactPersentage%
    On Error GoTo ErrH
    If CompactPersentage Then
        With Application
            AppCompactPersentage = .GetOption("Auto Compact Percentage")
            .SetOption "Auto Compact Percentage", CompactPersentage
        End With
    End If
    DbFile = Dir(DbFullName)
    DbPath = Left$(DbFullName, Len(DbFullName) - Len(DbFile))
    tmpFullName = DbPath & "tmp" & Replace(Format(Now, "hh:mm:ss"), ":", "_") & ".mdb"
    DBEngine.CompactDatabase DbFullName, tmpFullName
    Kill DbFullName: Name tmpFullName As DbFullName
ErrH:
    If Err = 0 Then
        MsgBox "Η βάση '" & DbFile & "' συμπυκνώθηκε με επιτυχία!"
    Else
        MsgBox "Σφάλμα: " & Err.Number & vbLf & vbLf & Err.Description
    End If
    If CompactPersentage Then Application.SetOption "Auto Compact Percentage", AppCompactPersentage
End Function

Η συνάρτηση καλείται με τον παρακάτω κώδικα:

Sub CompactGroupLarisa()
    CompactDB "C:\ GroupLarisa.mdb", 75    'Προσάρμοσε τη διαδρομή και  ποσοστό συμπύκνωσης
                                           '(η χρήση του τελευταίου είναι προαιρετική)

End Sub

Φιλικά

Τάσος