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 Dieser Tipp wurde bereits 23.120 mal aufgerufen.
Anzeige
![]() ![]() ![]() Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
Neu! sevCoolbar 3.0 ![]() Professionelle Toolbars im modernen Design! Mit sevCoolbar erstellen Sie in wenigen Minuten ansprechende und moderne Toolbars und passen diese optimal an das Layout Ihrer Anwendung an (inkl. große Symbolbibliothek) - für VB und MS-Access Tipp des Monats ![]() Dieter Otter PopUp-Menü wird nicht angezeigt :-( In diesem Tipp verraten wir Ihnen, wie Sie Probleme mit PopUp-Menüs umgehen können, wenn diese unter bestimmten Umständen einfach nicht angezeigt werden. vb@rchiv CD Vol.6 ![]() ![]() Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |