Compact Access Database with ADO
I've seen this one asked quite a bit. Contrary to popular belief, you don't need to use archaic DAO to compact an Access database . . .
I didn't document this code tremendously, I think it is pretty easy to follow.
VB Code:
' On a form
Option Explicit
Private Sub Command1_Click()
Dim sSource As String
Dim sDest As String
sSource = App.Path & "\Northwind.MDB"
sDest = App.Path & "\CompactNwind.MDB"
If CompactDB(sSource, sDest) Then
MsgBox "Compact complete"
End If
End Sub
' In a module
Option Explicit
'From MSDN . . .
'-----------------------------------------------
'Jet OLEDB:Engine Type Jet x.x Format MDB Files
'--------------------- ------------------------
' 1 JET10
' 2 JET11
' 3 JET2X
' 4 JET3X
' 5 JET4X
'-----------------------------------------------
Public Function CompactDB(ByVal sSource As String, ByVal sDest As String) As Boolean
'Requires references to:
' Microsoft Jet and Replication Objects 2.1 Library (or higher)
' Microsoft ActiveX Data Objects 2.5 Library (or higher)
Dim iEngineType As Integer
Dim jro As jro.JetEngine
Dim cn As ADODB.Connection
On Error GoTo CompactDB_Error
sSource = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sSource
' Find the engine type to use when compacting database
Set cn = New ADODB.Connection
With cn
.Open sSource
iEngineType = .Properties("Jet OLEDB:Engine Type")
.Close
End With
Set cn = Nothing
sDest = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Jet OLEDB:Engine Type=" & iEngineType & _
";Data Source=" & sDest
Set jro = New jro.JetEngine
jro.CompactDatabase sSource, sDest
CompactDB = True
Set jro = Nothing
On Error GoTo 0
Exit Function
CompactDB_Error:
CompactDB = False
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure CompactDB of Module Module1"
' Clean up any "junk" left behind
On Error Resume Next
Set cn = Nothing
Set jro = Nothing
On Error GoTo 0
End Function
