Procedure TFrmMenuPrin.Compactar;
Var
  dao : OLEVariant;
Begin
  Panel1.Visible := True;
  Dm.Conexao.Connected := False;
  Try
    Panel1.Caption := 'Compactando.Tabela';
    Panel1.Repaint;
    dao := CreateOleObject('ADO.DBEngine.36');
    dao.CompactDataBase(ExtractFileDir(Application.ExeName)+'\Banco.mdb',
    ExtractFileDir(Application.ExeName)+'\Banco2.mdb','',0,'');
    Panel1.Caption:='Apagando Arquivo Temporário';
    Panel1.Repaint;
    if FileExists(ExtractFileDir(Application.ExeName)+'\Banco2.mdb')then
      DeleteFile(ExtractFileDir (Application.ExeName)+'\Banco.mdb');
    Panel1.Caption:='Renomeando Arquivo';
    Panel1.Repaint;
    if FileExists(ExtractFileDir(Application.ExeName)+'\Banco2.mdb') then
      RenameFile(EXtractFileDir(Application.Exename)+'\Banco2.mdb',
    ExtractFileDir (Application.ExeName)+'\Banco.mdb');
    Panel1.Caption:='Arquivo Banco.mdb Compactado';
    Panel1.Repaint;
  Except
    Panel1.Caption:='Ocorreu um erro durante a Compactação';
  end;
  Dm.Conexao.ConnectionString := 'provider=Microsoft.jet.OLEDB.4.0;Data Souser='+
  ExtractFilePath(Application.ExeName)+'Banco.mdb;Persist Security info=False;';
  DM.Conexao.Connected := True;
  Panel1.Visible := False;
end;

procedure TFrmMenuPrin.actCompExecute(Sender: TObject);
begin
  if MessageDlg('Antes de confirmar esta operação, feche o banco de dados.'+#13+
                'Deseja efetuar a compactação do Banco de Dados?',
                mtConfirmation, [mbYes,mbNo], 0) = mrNo then
    abort;
  Compactar;
end;