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 24.225 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 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. |
sevZIP40 Pro DLL Zippen und Unzippen wie die Profis! Mit nur wenigen Zeilen Code statten Sie Ihre Anwendungen ab sofort mit schnellen Zip- und Unzip-Funktionen aus. Hierbei lassen sich entweder einzelnen Dateien oder auch gesamte Ordner zippen bzw. entpacken. Tipp des Monats März 2024 Dieter Otter UTF-8 Konvertierung von Dateien und Strings VB6 selbst verfügt über keine Funktionen zur UTF-8 Konvertierung von Daten. Mit Hilfe des ADODB.Stream-Objekts lassen sich diese fehlenden Funktionen aber schnell nachrüsten. TOP Entwickler-Paket TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
||||||||||||||||
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. |