jueves, 8 de septiembre de 2011

VBScript for compact Access Database

This script compact an Access Database, without the needed of having an Access installation on your Operating System.

Only replace FULLPATHFILENAME and FULLPATHFILENAME2 for original database and temporal database for compacting.

Ex: c:\database.mdb, c:\database_compacted.mdb

Sub Main()
Set Engine = CreateObject("JRO.JetEngine")
On Error Resume Next
Engine.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=FULLPATHFILENAME", "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=FULLPATHFILENAME2"
If Err.Number <> 0 Then
Err.Clear
Else
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile "FULLPATHFILENAME"
fso.MoveFile "FULLPATHFILENAME2", "FULLPATHFILENAME"
Set fso = Nothing
End If
Set Engine = Nothing
End Sub

VBA Compact Access Database

There are some functions for compact an Access Database.

This one, requires to add a reference to Microsoft Jet y biblioteca Replication Objects X.X

Public Function CompactDB()

Dim Cjro As JRO.JetEngine
Set Cjro = New JRO.JetEngine
Dim cnn1 As String, cnn2 As String

' Cadena de conexión de origen
cnn1 = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data source=" & CurrentDb.Name & ";" & _
"Jet OLEDB:Engine Type = 5;"

' Cadena de conexión de destino
cnn2 = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data source=" & Left(CurrentDb.Name, Len(CurrentDb.Name) - 4) & "_compactada.mdb" & ";" & _
"Jet OLEDB:Engine Type = 5"

Cjro.CompactDatabase cnn1, cnn2

End Function