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.248
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

Copyright ©2000-2024 vb@rchiv Dieter OtterAlle Rechte vorbehalten.

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.