Ciao, spero che usi ADO.
Eccoti una funzioncina..
Nel tuo progetto devi far riferimento alla libreria: Microsoft Jet and Replication Objects.codice:'passare il nome del database senza estensione... Private Sub CompattaMDB(nomeDB as string) Dim bytePrima As Long Dim cnCompact As New JRO.JetEngine Dim CONN_Sorg As String Dim CONN_Dest As String Dim dbBck As String Dim dbApp As String Dim dbTemp As String 'path e nome db, per salvare una copia dell'archivio prima della compattazione dbBck = App.Path & "\Backup\" & nomeDB & ".bck" 'path e nome db da compattare dbApp = App.Path & "\" & nomeDB & ".mdb" dbTemp = App.Path & "\~" & nomeDB & ".mdb" On Error GoTo errorCompact Screen.MousePointer = vbHourglass CONN_Sorg = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbApp & ";User ID=;Password=;" CONN_Dest = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbTemp & ";Jet OLEDB:Engine Type=5;" If Dir(dbBck) <> "" Then Kill dbBck End If FileCopy dbApp, dbBck bytePrima = FileLen(dbApp) If Dir(dbTemp) <> "" Then Kill dbTemp End If 'Compatta il database. cnCompact.CompactDatabase CONN_Sorg, CONN_Dest Kill dbApp Name dbTemp As dbApp 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(dbApp), 0), vbInformation, "COMPATTAZIONE DATABASE" Set cnCompact = Nothing 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(dbBck) <> "" Then If Dir(dbApp) <> "" Then Kill dbApp End If FileCopy dbBck, dbApp End If On Error GoTo 0 End Sub
Logicamente, prima di richiamare la funzione, il database deve essere chiuso!
![]()

Rispondi quotando