Rubrik: Access | VB-Versionen: VBA | 23.07.04 |
ACCESS 2000 Datenbank autom. komprimieren (VBA) Datenbank komprimiert sich selbst bei bestimmter GrößenDifferenz oder nach Anzahl von Aufrufen | ||
Autor: Richard Mittelstädt | Bewertung: | Views: 24.255 |
ohne Homepage | System: Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 | kein Beispielprojekt |
Mit nachfolgender Funktion wird unter MS-Access die aktuelle Datenbank nach dem Entladen des "Begrüßungsfensters" autom. komprimiert, falls notwendig.
Public Function KomprimierenWennZuGross() ' *************************************************************************** ' Diese Funktion aktiviert die Option - "Extras - Optionen - Allgemein - ' Beim Schliessen komprimieren" ' ' Hierzu muss eine extra Tabelle "Tab_BankGroesse" mit dem Feld "Bankgroesse" ' (Zahl) erstellt werden. ' *************************************************************************** ' Maximal erlaubte Differenz in MB: 1.0 MB ' "Nicht komprimiert - komprimiert" Const M_DIFF = 1 ' Maximale Programmstarts, bis (zwangs-)komprimiert wird Const M_COUNT = 12 ' entspricht Option "Beim Schliessen komprimieren" Const OPT_M = "Auto Compact" ' Aktuell gespeicherte Min- und Max-Einträge in der Tabelle Dim MAX_E, MIN_E On Error GoTo ErrHandler Dim oRs As Recordset Dim sSQL As String sSQL = "SELECT BankGroesse FROM Tab_BankGroesse ORDER BY BankGroesse" Set oRs = CurrentDb.OpenRecordset(sSQL, dbOpenDynaset) If oRs.RecordCount = 0 Then oRs.AddNew oRs![BankGroesse] = 0 oRs.Update Application.SetOption OPT_M, -1 End If MAX_E = Format(DMax("[BankGroesse]", "Tab_BankGroesse") / 1024 / 1024, "0.00") MIN_E = Format(DMin("[BankGroesse]", "Tab_BankGroesse") / 1024 / 1024, "0.00") ' beim letzten Schliessen wurde komprimiert If Application.GetOption(OPT_M) = -1 Then ' auf den ersten Satz ! oRs.MoveFirst If Not oRs![BankGroesse] = 0 Then MIN_E = Format(FileLen(CurrentDb.Name) / 1024 / 1024, "0.00") MsgBox "Letze Komprimierung von " & MAX_E & " MB auf " & MIN_E & " MB" End If oRs.Edit Do Until oRs.EOF oRs.Delete oRs.MoveNext Loop oRs.AddNew oRs![BankGroesse] = FileLen(CurrentDb.Name) oRs.Update ' Option wieder deaktivieren! Application.SetOption OPT_M, 0 Else oRs.AddNew oRs![BankGroesse] = FileLen(CurrentDb.Name) oRs.Update ' jetzige Groesse (neuester Wert) mit beruecksichtigen MAX_E = Format(DMax("[BankGroesse]", "Tab_BankGroesse") / 1024 / 1024, "0.00") MIN_E = Format(DMin("[BankGroesse]", "Tab_BankGroesse") / 1024 / 1024, "0.00") If (MAX_E - MIN_E > M_DIFF) Or (DCount("[BankGroesse]", "Tab_BankGroesse") > M_COUNT) Then ' Option aktivieren, beim nächsten Schliessen komprimieren ! Application.SetOption OPT_M, -1 End If End If oRs.Close Set oRs = Nothing Exit Function ErrHandler: MsgBox Err.Number & " " & Err.Description End Function