Die Community zu .NET und Classic VB.
Menü

VB 5/6-Tipp 0586: ADO-Datenbanken komprimieren

 von 

Beschreibung 

Nach vielen Änderungen etc. kann es passieren, dass eine Datenbank ziemlich groß wird. Dabei lässt sie sich so einfach komprimieren! Abhilfe schaffen hier die "MS Jet and Replikation Objects" mit der Methode "CompactDatabase".

Schwierigkeitsgrad:

Schwierigkeitsgrad 2

Verwendete API-Aufrufe:

keine

Download:

Download des Beispielprojektes [2,6 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'----------- Anfang Projektdatei ADOCompress.vbp  -----------
' Es muss ein Verweis auf 'Microsoft Jet and Replication Objects 2.6 Library' gesetzt werden.
' Die Komponente 'Microsoft Common Dialog Control 6.0 (SP3) (COMDLG32.OCX)' wird benötigt.

'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Rahmensteuerelement "Frame1"
' Steuerelement: Schaltfläche "cmd_compress" auf Frame1
' Steuerelement: Schaltfläche "cmd_auswahl" auf Frame1
' Steuerelement: Textfeld "txt_filename" auf Frame1
' Steuerelement: Beschriftungsfeld "Label1" auf Frame1
' Steuerelement: Standarddialog-Steuerelement "CommonDialog1"
' Steuerelement: Schaltfläche "cmd_Quit"

Option Explicit

Private Sub cmd_auswahl_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
  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

Private Sub cmd_Quit_Click()
  Unload Me
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'------------ Ende Projektdatei ADOCompress.vbp  ------------

Tipp-Kompatibilität:

Windows/VB-VersionWin32sWin95Win98WinMEWinNT4Win2000WinXP
VB4
VB5
VB6

Hat dieser Tipp auf Ihrem Betriebsystem und mit Ihrer VB-Version funktioniert?

Ja, funktioniert!

Nein, funktioniert nicht bei mir!

VB-Version:

Windows-Version:

Ihre Meinung  

Falls Sie Fragen zu diesem Artikel haben oder Ihre Erfahrung mit anderen Nutzern austauschen möchten, dann teilen Sie uns diese bitte in einem der unten vorhandenen Themen oder über einen neuen Beitrag mit. Hierzu können sie einfach einen Beitrag in einem zum Thema passenden Forum anlegen, welcher automatisch mit dieser Seite verknüpft wird.

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 7 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.

Kommentar von mischarichter am 27.08.2008 um 12:33

mit einer kleinen Änderung geht dann die Öffnung von kennwortgesch. DBs doch:

TMPDB1 = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & DBOriginal & "; Jet OLEDB:Database Password=" & "123"

TMPDB2 = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & DBTemp & "; Jet OLEDB:Database Password=" & "123"


Jedenfalls bei mir mit VB6 und o.g. Provider zu den lokalen MDB-Files.

Mischa

Kommentar von pks am 27.08.2008 um 12:19

es können auch PWD geschützte MDBs comprimiert werden

'Datenbank komprimieren, optional Passwort ändern
'liefert den neuen Namen der ursprünglichen mdb
Public Function CompactMDB(ActConn As ADODB.Connection, _
Optional doNotChangePWD As Boolean = True, _
Optional NewPWD As String = "", _
Optional ErrNumber As Long = 0, _
Optional ErrDescription As String = "", _
Optional ShowErrorMsg As Boolean = True) _
As String

Dim objJRO As Object
Dim dbName As String, dbNew As String
Dim EngineTyp As String
Dim OldPwd As String, Dummy As String
Dim Con1 As String, Con2 As String
Dim i As Long

'DB Name, Passwort und EngineTyp ermitteln
dbName = ActConn.Properties("Data Source").Value
OldPwd = ActConn.Properties("Jet OLEDB:Database Password").Value
EngineTyp = ActConn.Properties("Jet OLEDB:Engine Type").Value

'neues Passwort festlegen
If doNotChangePWD Then
NewPWD = OldPwd
End If

'SaveMDB ermitteln
dbNew = dbName
i = InStrRev(dbNew, ".")
dbNew = Left(dbNew, i - 1) & "_" & _
Format(Now, "yyyymmdd\_hhnnss") & ".mdb"

'ein Dummy für die Umbenennung
i = InStrRev(dbName, "\")
Dummy = Left(dbName, i)
i = 0
Do
If Len(Dir(Dummy & "dummy" & i & ".mdb")) = 0 Then
Dummy = Dummy & "dummy" & i & ".mdb"
Exit Do
End If
i = i + 1
Loop

'ConnectionStrings festlegen
Con1 = "Data Source=" & dbName & ";" & _
"Jet OLEDB:Database Password=" & OldPwd & ";" & _
"Jet OLEDB:Engine Type=" & EngineTyp & ";"

Con2 = "Data Source=" & dbNew & ";" & _
"Jet OLEDB:Database Password=" & NewPWD & ";" & _
"Jet OLEDB:Engine Type=" & EngineTyp & ";"

On Error Goto Fehler

'Connection schliessen
ActConn.Close

'Jet-Engine starten
Set objJRO = CreateObject("JRO.JetEngine")

'Datenbank komprimieren
objJRO.CompactDatabase Con1, Con2

'umbenennen
Name dbName As Dummy
Name dbNew As dbName
Name Dummy As dbNew
CompactMDB = dbNew

Fehler:
If Err.Number <> 0 Then
ErrNumber = Err.Number
ErrDescription = Err.Description
If ShowErrorMsg Then
FehlerAnzeige Err.Number, Err.Description, "CompactMDB"
End If
End If
On Error Goto 0

'Connection wieder öffnen
ActConn.Open
End Function


'Anzahl (und Namen/Computer) der aktuelle mdb Nutzer
Public Function CurrentUserCount(ActConn As ADODB.Connection, _
Optional sUser As String = "") As Long

Dim Rs As ADODB.Recordset
Dim User As String, Computer As String
Dim s() As String
Dim i As Long, j As Long

Set Rs = ActConn.OpenSchema(adSchemaProviderSpecific, , _
"{947bb102-5d43-11d1-bdbf-00c04fb92675}")

i = Rs.RecordCount
CurrentUserCount = i

ReDim s(i - 1)
i = 0
Do While Not Rs.EOF
User = Rs.Fields("Login_Name").Value
j = InStr(1, User, Chr(0))
If j > 0 Then
User = Left(User, j - 1)
End If
Computer = Rs.Fields("Computer_Name").Value
j = InStr(1, Computer, Chr(0))
If j > 0 Then
Computer = Left(Computer, j - 1)
End If

s(i) = User & ":" & Computer
i = i + 1
Rs.MoveNext
Loop

sUser = Join(s, ";")
Rs.Close
Set Rs = Nothing
End Function


Kommentar von mischarichter am 27.08.2008 um 11:26

der code geht bei password-geschützten DBs nicht.
an ADO_JRO.CompactDatabase TMPDB1, TMPDB2 kann kein pw übergeben werden.

Mischa Richter

Kommentar von Rüdiger Jörder am 10.11.2003 um 16:18

Wie kann ich den Verweis in VB 4.0 voreinstellen. Verweis funktioniert nämlich nur, wenn ich VB 4.0 öffne, den Verweis einstelle und dann das VB-Programm starte.

MfG

Kommentar von Helmut Kubasek am 29.07.2003 um 16:01

Hallo,

ich habe folgendes Problem:
Der Programmcode soll bei Beenden meines Programmes ausgeführt werden, aber ich erhalte die Fehlermeldung, dass auf die Datenbank nicht zugegriffen werden kann, weil sie bereits geöffnet ist. Ich habe allerdings vorher die Datenbank geschlossen[DB.Close].
Was läuft da schief ?

Vielen Dank

Gruß Helmut

Kommentar von Ini am 30.05.2003 um 22:20

Hi

Wie gehe ich vor, wenn meine DB an eine System Database (xy.mdw) gebunden ist.
Die Definition von User ID und Password funktioniert bei mir nicht.

Gruss Ini

Kommentar von pks am 11.05.2003 um 17:40

1. der FileCopy ist überflüssig, ein Umbenennen mit Name reicht völlig aus
2. ich lasse in solchen Fällen das Original aus Sicherheitsgründen noch auf der Platte und benenne es
einfach um wie DBNameyyyymmddhhnnss.mdb und lösche es zu einem späteren Zeitpunkt