VB and VBA Users Source Code: Compact a JET database using ADO
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Compact a JET database using ADO
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Monday, January 15, 2001
Hits:
972
Category:
Files/Directories/IO
Article:
The following routines demonstrates how to compact a JET database using ADO: Option Explicit 'Purpose : Compact a JET (Access) database using ADO 'Inputs : sDatabasePath The path to the database path eg. C:\nwind.mdb ' [bEncryptDatabase] If True, encrypts the contents of the database 'Outputs : Returns zero if successful, else returns error code 'Author : Andrew Baker 'Date : 15/01/2001 11:55 'Notes : Requires "Microsoft Jet and Replication Objects X.X library", ' where (X.X is greater than or equal to 2.1) ' Compacts the database by creating a temporary database with the extension .tmp then, ' if the compaction is successful, it overwrites the original database. ' Will not work if anyone else is connected to the database. 'Revisions : 'Assumptions : Function DatabaseCompact(sDatabasePath As String, Optional bEncryptDatabase As Boolean = False) As Long Dim oJRO As Object 'JRO.JetEngine On Error GoTo ErrFailed If Len(Dir$(sDatabasePath & ".tmp")) Then 'Delete the existing temp database VBA.Kill sDatabasePath & ".tmp" End If Set oJRO = CreateObject("JRO.JetEngine") If bEncryptDatabase Then 'Compact and encrypt the database oJRO.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sDatabasePath, "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sDatabasePath & ".tmp;Jet OLEDB:Encrypt Database=True" Else 'Compact the database oJRO.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sDatabasePath, "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sDatabasePath & ".tmp;Jet OLEDB:Engine Type=4" End If 'Delete the existing database VBA.Kill sDatabasePath 'Rename the compacted database Name sDatabasePath & ".tmp" As sDatabasePath Set oJRO = Nothing Exit Function ErrFailed: Debug.Print "Failed to compact database: " & Err.Description DatabaseCompact = Err.Number Set oJRO = Nothing On Error GoTo 0 End Function 'Demonstration routine Sub Test() Dim lRes As Long On Error Resume Next lRes = DatabaseCompact("C:\test.mdb", True) If lRes = 0 Then MsgBox "Succeeded in compacting database...", vbInformation Else 'Show error message MsgBox Error(lRes) End If Exit Sub ErrFailed: MsgBox Err.Description End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
