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 |