Compact Access Database Using ADO

Category:

Database

Type:

Modules

Difficulty:

Beginning

Author:

Sanjaya Warakagoda

Version Compatibility: Visual Basic 6

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
'None

Code:

'**********************************************************
'Passing values compactDB module
'Sour_path = Source path of existing database.
'Dest_Path = Target path 
'
'Note - 
'Add Microsoft Jet and Replication Objects X.X library,
'where (X.X is greater than or equal to 2.1).
'***********************************************************
'Jet OLEDB:Engine Type  Jet x.x Format MDB Files 
'*********************  ************************
'	1 			JET10 
'	2			JET11 
'	3			JET2X 
'	4			JET3X 
'	5			JET4X 
'**********************************************************

Option Explicit
 
Public Function compactDB(ByVal SOUR_path As String, _
   ByVal DEST_path As String) As Boolean
 
  On Error GoTo Err_compact
  Private JRO As New JRO.JetEngine

' Source and Destination connection path
  Private DB_sour As String, DB_dest As String

DoEvents
  DB_sour = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
      & SOUR_path
  DB_dest = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
      & DEST_path & " ;Jet OLEDB:Engine Type=5"
  
     JRO.CompactDatabase DB_sour, DB_dest
  
  compactDB = True
  Exit Function
  
Err_compact:
  compactDB = False
  MsgBox Err.Description, vbExclamation
End Function

'*************************************************
' Usage Module level or form level.
'*************************************************

' Dim source_path,Target_path as string

' source_path=App.Path & "\Nwind.MDB"
' Target_path=App.Path & "\CompactNwind.MDB"

' If not compactDB(source_path,Target_path) Then
' MsgBox "An error occurred while attempt to rename database " _
' & vbCrLf & vbCrLf & DBCP_Name, vbExclamation
' End If