Utilizzando il modulo sotto
codice:
Private Sub CompattaMDB_ADO()
Dim bytePrima As Long
Dim cnCompact As New JRO.JetEngine
Dim CONN_Sorg As String
Dim CONN_Dest As String
Dim dbBackup As String
Dim dbOriginale As String
Dim dbTemp As String
dbBackup = App.Path & "\Backup\TuoDB.bck"
dbOriginale = App.Path & "\TuoDB.mdb"
dbTemp = App.Path & "\~TuoDB.mdb"
On Error GoTo errorCompact
ChiudiDB
Screen.MousePointer = vbHourglass
CONN_Sorg = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbOriginale & ";User ID=;Password=;"
CONN_Dest = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbTemp & ";Jet OLEDB:Engine Type=5;"
If Dir(dbBackup) <> "" Then
Kill dbBackup
End If
FileCopy dbOriginale, dbBackup
bytePrima = FileLen(dbOriginale)
If Dir(dbTemp) <> "" Then
Kill dbTemp
End If
'Compatta il database.
cnCompact.CompactDatabase CONN_Sorg, CONN_Dest
Kill dbApp
Name dbTemp As dbOriginale
Screen.MousePointer = vbNormal
MsgBox "Compattazione del database terminata con successo." & vbCr _
& "Prima della compattazione Byte: " & FormatNumber(bytePrima, 0) & vbCr _
& "Dopo la compattazione Byte: " & FormatNumber(FileLen(dbOriginale), 0), vbInformation, "COMPATTAZIONE DATABASE"
Set cnCompact = Nothing
ApriDB
On Error GoTo 0
Exit Sub
errorCompact:
Set cnCompact = Nothing
Screen.MousePointer = vbNormal
MsgBox "Errore durante il tentativo di compattazione del database: " & vbCr & "Numero errore: " & Err.Number & vbCr & "Descrizione: " & Err.Description, vbCritical, "Service"
If Dir(dbBackup) <> "" Then
If Dir(dbOriginale) <> "" Then
Kill dbOriginale
End If
FileCopy dbBackup, dbOriginale
End If
iF IsDbClose Then
ApriDB
End If
On Error GoTo 0
End Sub
Come è possibile far scegliere ogni volta all'utente dove salvare il database? Insomma far partire la finestra di salva con nome o robba simile.
Grazie