VB 5/6-Tipp 0586: ADO-Datenbanken komprimieren
von Thomas Bräutigam
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: | Verwendete API-Aufrufe: keine | Download: |
'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-Version | Win32s | Win95 | Win98 | WinME | WinNT4 | Win2000 | WinXP |
VB4 | ![]() | ![]() | ![]() | ![]() | ![]() | ![]() | ![]() |
VB5 | ![]() | ![]() | ![]() | ![]() | ![]() | ![]() | ![]() |
VB6 | ![]() | ![]() | ![]() | ![]() | ![]() | ![]() | ![]() |
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