Utilizzando il modulo sotto
Come è possibile far scegliere ogni volta all'utente dove salvare il database? Insomma far partire la finestra di salva con nome o robba simile.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
Grazie

Rispondi quotando