Database - Compatta Database

Tabelle # Una semplice routine che dimostra come compattare un database da Visual Basic
Sub CompactDB(DBName As String)
'Nella stringa DBName spcificare il nome del DB da compattare

'completo del path

On Error Resume Next
Dim TmpFile As String
Dim FileDataBase As String
Dim Messaggio As String
Dim DimIniziale As Long
Dim DimFinale As Long
Dim Differenza As Long
Dim Percentuale As Long
Dim Tmp As String * 20
FileDataBase = DBName
Screen.MousePointer = 11
TmpFile = App.Path & "\data.tmp"
DimIniziale = FileLen(FileDataBase)
CompactDatabase FileDataBase, TmpFile
If Dir$(TmpFile) <> "" Then
Kill FileDataBase
Name TmpFile As FileDataBase
Else
Messaggio = "Errore durante la compressione del file"
Messaggio = Messaggio + "Il Database non e' stato compresso"
Screen.MousePointer = 0
MsgBox Messaggio, 48, "Attenzione"
Exit Sub
End If
DimFinale = FileLen(FileDataBase)
Differenza = DimIniziale - DimFinale
Percentuale = 100 - (100 * (DimFinale / DimIniziale))
Messaggio = "Compressione completata!" & vbCrLf & vbCrLf
RSet Tmp = Format$(DimIniziale, "##,###,##0")
Messaggio = Messaggio & "-------------------------" & vbCrLf
Messaggio = Messaggio + "Dimensioni originali (bytes)" & Tmp & vbCrLf
RSet Tmp = Format$(DimIniziale, "##,###,##0")
Messaggio = Messaggio + "Dimensioni compresse (bytes)" & Tmp & vbCrLf
RSet Tmp = Format$(Differenza, "##,###,##0")
Messaggio = Messaggio & "-------------------------" & vbCrLf
Messaggio = Messaggio + "Spazio liberato (bytes)" & Tmp & vbCrLf & vbCrLf
RSet Tmp = Format$(Percentuale, "##,###,##0")
Messaggio = Messaggio + "Percentuale di compressione" & Tmp
Screen.MousePointer = 0
MsgBox Messaggio, 64, "Statistiche sulla compressione"
End Sub