[Страдалецъ]

Мы не ищем легких путей.
Такой вот вариант:

Код:

unit Unit7;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, ADODB, ComObj, ComCtrls, Grids, DBGrids;

type
  TfrmDuplicator = class(TForm)
    AppDB: TADOConnection;
    OpenDialog: TOpenDialog;
    btnSource: TButton;
    edSource: TEdit;
    edDestination: TEdit;
    btnDestination: TButton;
    Label1: TLabel;
    Label2: TLabel;
    btnCopy: TButton;
    ProgressBar: TProgressBar;
    qTable: TADOCommand;
    qTables: TADOQuery;
    procedure btnSourceClick(Sender: TObject);
    procedure btnCopyClick(Sender: TObject);
    procedure btnDestinationClick(Sender: TObject);
  end;

var
  frmDuplicator: TfrmDuplicator;

implementation

{$R *.dfm}

function CreateMDB(DBName: String): Boolean;
var
  DBEngine,Workspace: Variant;
const
  dbLangGeneral = ';langid=0x0409;cp=1252;country=0';
  dbVersion30 = 32;
begin
 Result := False;
 try
  try
   DBEngine := CreateOleObject('DAO.DBEngine.36');
  except
   try
    DBEngine := CreateOleObject('DAO.DBEngine.35');
   except
   raise;
   end;
  end;
  Workspace := DBEngine.Workspaces[0];
  try
   Workspace.CreateDatabase(DBName, dbLangGeneral, dbVersion30);
  except
  on Err: EOleException
     do ShowMessage(Err.Message);
  end;
 except
 on Err: EOleException
    do ShowMessage(Err.Message);
 end;
 Result := True;
end;

procedure TfrmDuplicator.btnCopyClick(Sender: TObject);
begin
 if not CreateMDB(edDestination.Text) then Exit;
 AppDB.ConnectionString := Format('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;'+
                                  'Jet OLEDB:Create System Database=true;'+
                                  'Jet OLEDB:System database=C:\Users\Хозяин\AppData\Roaming\Microsoft\Access\System.mdw',
                                  [edSource.Text]);
 AppDB.LoginPrompt := False;
 AppDB.Open;

 qTables.SQL.Text := 'SELECT Name from MSysObjects where Type=1 and Flags=0';
 qTables.Open;
 ProgressBar.Max := qTables.RecordCount;
 ProgressBar.Position := ProgressBar.Min;
 while not qTables.Eof
 do begin
    qTable.CommandText := Format('SELECT TOP 1 * INTO %s IN ''%s'' FROM %s',
                          [qTables.FieldValues['Name'],edDestination.Text,qTables.FieldValues['Name']]);
    qTable.Execute;
    qTables.Next;
    ProgressBar.StepIt;
    end;

end;

procedure TfrmDuplicator.btnDestinationClick(Sender: TObject);
begin
 if not OpenDialog.Execute then Exit;
 edDestination.Text := OpenDialog.FileName;
 btnCopy.Enabled := True;
end;

procedure TfrmDuplicator.btnSourceClick(Sender: TObject);
begin
 if not OpenDialog.Execute then Exit;
 edSource.Text := OpenDialog.FileName;
 edDestination.Enabled := True;
 btnDestination.Enabled := True;
end;

end.

и .dfm

Код:

object frmDuplicator: TfrmDuplicator
  Left = 0
  Top = 0
  Caption = #1044#1091#1073#1083#1080#1082#1072#1090#1086#1088
  ClientHeight = 98
  ClientWidth = 409
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 8
    Top = 11
    Width = 52
    Height = 13
    Caption = #1048#1089#1090#1086#1095#1085#1080#1082':'
  end
  object Label2: TLabel
    Left = 8
    Top = 38
    Width = 53
    Height = 13
    Caption = #1055#1088#1080#1077#1084#1085#1080#1082':'
  end
  object btnSource: TButton
    Left = 377
    Top = 8
    Width = 24
    Height = 21
    Caption = '...'
    TabOrder = 0
    OnClick = btnSourceClick
  end
  object edSource: TEdit
    Left = 67
    Top = 8
    Width = 310
    Height = 21
    TabOrder = 1
    Text = #1042#1099#1073#1077#1088#1080#1090#1077' '#1080#1084#1103' '#1092#1072#1081#1083#1072' '#1073#1072#1079#1099' '#1086#1090#1082#1091#1076#1072' '#1073#1091#1076#1077#1084' '#1082#1086#1087#1080#1088#1086#1074#1072#1090#1100
  end
  object edDestination: TEdit
    Left = 67
    Top = 35
    Width = 310
    Height = 21
    Enabled = False
    TabOrder = 2
    Text = #1042#1099#1073#1077#1088#1080#1090#1077' '#1080#1084#1103' '#1092#1072#1081#1083#1072' '#1073#1072#1079#1099' '#1082#1091#1076#1072' '#1073#1091#1076#1077#1084' '#1082#1086#1087#1080#1088#1086#1074#1072#1090#1100
  end
  object btnDestination: TButton
    Left = 377
    Top = 35
    Width = 24
    Height = 21
    Caption = '...'
    Enabled = False
    TabOrder = 3
    OnClick = btnDestinationClick
  end
  object btnCopy: TButton
    Left = 8
    Top = 62
    Width = 121
    Height = 25
    Caption = #1053#1072#1095#1072#1090#1100' '#1082#1086#1087#1080#1088#1086#1074#1072#1085#1080#1077
    Enabled = False
    TabOrder = 4
    OnClick = btnCopyClick
  end
  object ProgressBar: TProgressBar
    Left = 135
    Top = 65
    Width = 242
    Height = 17
    Step = 1
    TabOrder = 5
  end
  object AppDB: TADOConnection
    ConnectionString = 
      'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=E:\DBase\KLADR.mdb;' +
      'Persist Security Info=False'
    Provider = 'Microsoft.Jet.OLEDB.4.0'
    Left = 168
    Top = 64
  end
  object OpenDialog: TOpenDialog
    DefaultExt = '*.mdb'
    Filter = #1041#1072#1079#1099' '#1076#1072#1085#1085#1099#1093' MS Access (*.mdb)|*.mdb|'#1042#1089#1077' '#1092#1072#1081#1083#1099' (*.*)|*.*'
    Left = 136
    Top = 64
  end
  object qTable: TADOCommand
    Connection = AppDB
    Parameters = <>
    Left = 232
    Top = 64
  end
  object qTables: TADOQuery
    Connection = AppDB
    Parameters = <>
    Left = 200
    Top = 64
  end
end