Option Explicit
Public txt_Filename
 
Private Sub cmd_dbAuswahl_Click()
  Me.CommonDialog1.Filter = "Datenbanken (*.mdb)|*.mdb"
  Me.CommonDialog1.FilterIndex = 1
  Me.CommonDialog1.DefaultExt = "mdb"
  Me.CommonDialog1.ShowOpen
  Me.txt_Filename = CommonDialog1.FileName
End Sub
 
Private Sub cmd_compress_Click()
  'Für die Verwendung von CompactDatabase mit ADO:
  'Benötigt in den Verweisen:
  'MS Jet and Replikation Objects 2.6 Library,
  'sollte mit allen Access-Versionen gehen.
 
  Dim ADO_JRO As New jro.JetEngine  (Diese Fehler taucht auf)
  Dim DBOriginal As String
  Dim DBTemp As String
  Dim TMPDB1 As String
  Dim TMPDB2 As String
 
  DBOriginal = Replace(txt_Filename.text, "\\", "\")
  DBTemp = Replace(App.Path & "\Help.mdb", "\\", "\")
 
  MsgBox "Die Datenbank hat eine Grösse von: " & Format(FileLen(DBOriginal), _
    "#,###") & " Byte"
 
  If Dir(DBTemp) <> "" Then
    Kill DBTemp
  End If
 
  TMPDB1 = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & DBOriginal
  TMPDB2 = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & DBTemp
 
  ADO_JRO.CompactDatabase TMPDB1, TMPDB2
 
  Set ADO_JRO = Nothing
  Kill DBOriginal
  FileCopy DBTemp, DBOriginal
  Kill DBTemp
  MsgBox "Die Datenbank hat eine Grösse von: " & Format(FileLen(DBOriginal), _
    "#,###") & " Byte"
End Sub
 
  Unload Me