procedure TForm1.CompactaMDB(Sender: TObject);
var db: OleVariant;
PathDb: string;
begin
PathDb := 'C:\Prueba Compactar BBDD\Datos.mdb';
db := GetADOObject('JRO.JetEngine');
db.CompactDatabase('Provider=Microsoft.Jet.OLEDB.4.0;' +
'Data Source=' + PathDb + ';Jet OLEDBatabase Password="";',
'Provider=Microsoft.Jet.OLEDB.4.0;' +
'Data Source=' + ExtractFilePath(PathDb) + 'Datos_new.mdb' +
';Jet OLEDB:Database Password=""' +
';Jet OLEDB:Engine Type=5'); // 4 se for Access 97
if not DeleteFile(PathDb) then
// file://Borrar bd antigua
begin
ShowMessage('Ocurrienron errores renombrando los archivos temporales!'
+ #13 + 'La operacion fue cancelada.');
DeleteFile(ExtractFilePath(PathDb) + 'nuevabd.mdb');
// file://Borrar archivos temporales
exit;
end;
RenameFile(ExtractFilePath(PathDb) + 'nuevaBD.mdb', PathDb);
//file://Renombra la bd compactada
DeleteFile(ExtractFilePath(PathDb) + 'nuevabd.mdb');
//file://Borrar archivos temporales
//*** Renombrar de nuevo la BD y ponerle el nombre original ***\\
RenameFile(ExtractFilePath(PathDb) + 'Datos_new.mdb', ExtractFilePath(PathDb) + 'Datos.mdb');
ShowMessage('Proceso Concluído con exito!');
{except
on e: Exception do
ShowMessage(E.Message);
end
finally
db := unassigned;
// file://Limpia variables de objetos
end;}
end;
function TForm1.GetADOObject(ADOClass: string): OLEVariant;
var o: OLEVariant;
begin
try
o := CreateOLEObject(ADOClass);
except on EOleException do
o := unassigned
end;
Result := o;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Mi_conexion.Connected := false; //AdoConection
Mi_Conexion.Close;
AdoTable1.Close;
CompactaMDB(sender); //llamamos al procedimiento
Mi_Conexion.Connected := true;
Mi_Conexion.Open;
AdoTable1.Open;
end;