vb@rchiv · Tipps & Tricks · Access-Datenbank komprimieren (.NET)

Rubrik: Datenbanken | VB-Versionen: VB.NET

11.02.08

Access-Datenbank komprimieren (.NET) Mit dieser Funktion lässt sich unter .NET eine Access-Datenbank komprimieren.
Autor: Heinz Prelle	Bewertung:	Views: 17.690
www.visual-basic5.de	System: WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Mit nachfolgender Funktion lässt sich eine Access-Datenbank (Access 2000 oder höher) unter Verwendung der COM-Schnittstelle "JRO.Engine" komprimieren. Über den optionalen Parameter kann zudem festgelegt werden, ob die Original-Datenbank nach erfolgreichem Komprimierungsvorgang gelöscht werden soll.

' benötigte Imports
Imports System.Activator
Imports System.Type
Imports System.Runtime.InteropServices
Imports System.IO
Imports System.Reflection

Private Function CompressAccessDataBase( _
  ByVal SourceFilename As String, _
  ByVal NewFilename As String, _
  Optional ByVal bDeleteSource As Boolean = False) As Boolean
 
  Try
    ' Connection-String festlegen
    Dim Connection As String = _
      "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
      SourceFilename
 
    ' Verweis auf die COM-Schnittstelle "JRO.Engine"
    Dim jro As Object = CreateInstance( _
      GetTypeFromProgID("JRO.JetEngine"))
 
    ' Parameter festlegen
    Dim Params As Object() = _
      New Object() {Connection, _
      "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
      SourceFilename & _
      ".tmp ;Jet OLEDB:Engine Type=5"}
 
    ' Komprimiervorgang starten
    jro.GetType().InvokeMember("CompactDatabase", _
      BindingFlags.InvokeMethod, Nothing, jro, Params)
 
    ' ggf. Quelldatei löschen
    If bDeleteSource Then File.Delete(SourceFilename)
 
    ' temporäre (komprimierte) Datenbank an den Zielort verschieben
    File.Move(SourceFilename & ".tmp", NewFilename)
 
    ' COM-Objekt wieder freigeben
    Marshal.ReleaseComObject(jro)
    jro = Nothing
 
    Return (File.Exists(NewFilename))
 
  Catch ex As Exception
    MessageBox.Show(ex.Message.ToString(), "Info")
    Return False
  End Try
End Function