1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
|
Public Sub compress_db(database_path As String)
Dim fs As New FileSystemObject
Dim je As New jro.JetEngine
Dim l_strNewDatabasePath As String
On Error GoTo exit_sub
l_strNewDatabasePath = database_path + ".new"
Set je = New jro.JetEngine
' compact .mdb towards .new
If fs.FileExists(l_strNewDatabasePath) Then
fs.DeleteFile l_strNewDatabasePath, True
End If
je.CompactDatabase "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + database_path, _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" + l_strNewDatabasePath + ";Jet OLEDB:Encrypt Database=True"
' traitement ..........
exit_sub:
fs.DeleteFile l_strNewDatabasePath
Exit Sub
End Sub |
Partager