Option Explicit

Private Sub Command1_Click()
  Komprimieren
End Sub

Sub Komprimieren()
  Dim quelle As String
  Dim n As String, v As String, e As String

  On Error GoTo fehler

  CmDialog1.Filter = "Access (*.mdb)|*.mdb"
  CmDialog1.Flags = &H1000
  CmDialog1.FilterIndex = 1
  CmDialog1.Action = 1

  If CmDialog1.FileName <> "" Then
    quelle = CmDialog1.FileName
    fileSplit quelle, v, n, e
    CompactDatabase quelle, v & n & ".$$$"
    Kill quelle
    Name v & n & ".$$$" As quelle
    MsgBox "Komprimierung erfolgreich abgeschlossen!", 64, _
          "Information"
  End If

  Exit Sub

fehler:
  MsgBox "Fehler bei der Ausführung!", 16, "Problem"
  Exit Sub
  Resume Next
End Sub

Private Sub Command2_Click()
  Reparieren
End Sub

Sub Reparieren()
  Dim quelle As String
  Dim n As String, v As String, e As String

  On Error GoTo fehler1

  CmDialog1.Filter = "Access (*.mdb)|*.mdb"
  CmDialog1.Flags = &H1000
  CmDialog1.FilterIndex = 1
  CmDialog1.Action = 1
  If CmDialog1.FileName <> "" Then
    Screen.MousePointer = 11
    quelle = CmDialog1.FileName
    RepairDatabase (quelle)
    Screen.MousePointer = 0

    MsgBox "Datenbank erfolgreich repariert!", 64, "Information"

    If MsgBox("Soll die Datenbank komprimiert werden?", 36, _
            "Frage") = 6 Then
      Screen.MousePointer = 11
      fileSplit quelle, v, n, e
      CompactDatabase quelle, v & n & ".$$$"
      Kill quelle
      Name v & n & ".$$$" As quelle
      MsgBox "Komprimierung erfolgreich abgeschlossen!", 64, _
            "Information"
    End If
  End If

  Screen.MousePointer = 0
  Exit Sub

fehler1:
  MsgBox "Fehler bei der Ausführung!", 16, "Problem"
  Screen.MousePointer = 0
  Exit Sub
  Resume Next
End Sub

Sub fileSplit(ByVal s$, path$, file$, ext$)
  Dim i As Integer

  For i = Len(s) To 1 Step -1
    If Mid(s, i, 1) = "\" Then
      ext = ""
      Exit For
    End If
    If Mid(s, i, 1) = "." Then
      ext = Right(s, Len(s) - i)
      s = Left(s, i - 1)
      Exit For
    End If
  Next i

  i = Len(s)
  If InStr(s, "\") <> 0 Then
    While Mid(s, i, 1) <> "\"
      i = i - 1
    Wend
  End If

  path = Left(s, i)
  file = Right(s, Len(s) - i)
End Sub