{ Snipperize }
Compact Access DB with ADO
Compact Access DB with ADO Add to Favorite
Public Function DbCompact(oldDb As String, Optional bakDb As String = "") As Integer
'Needs Microsoft Jet and Replication Objects Library
'Needs Microsoft ActiveX Data Objects Library
'Needs Microsoft Scripting Runtime
'Returns 0 if OK, -1 if FAIL
DbCompact = -1
On Error GoTo noDbOk
Dim j As JetEngine
Dim fso As FileSystemObject
Dim jStr As String, newDb As String
Set fso = New FileSystemObject
If Not fso.FileExists(oldDb) Then Exit Sub
Set j = New JetEngine
jStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="
newDb = App.Path & "\tmpDb.mdb"
j.CompactDatabase jStr & oldDb, jStr & newDb
If Trim(bakDb) <> "" Then
If fso.FileExists(bakDb) Then fso.DeleteFile bakDb
fso.MoveFile oldDb, bakDb
Else
fso.DeleteFile oldDb
End If
fso.MoveFile newDb, oldDb
DbCompact = 0
noDbOk:
Set fso = Nothing
Set j = Nothing
End Sub
'Needs Microsoft Jet and Replication Objects Library 'Needs Microsoft ActiveX Data Objects Library 'Needs Microsoft Scripting Runtime
Created by ThePeppersStudio (47 days, 15.06 hours ago)
Do you want to leave a message? Please login first.

