再问动态创建ACCESS数据库的问题

你有正确安装了mdac了吗？
这是我自己编写的一个根据dataset导出access的函数
其中CreateDatabase(FName:string); 是新建一个access数据库
CreateTable(tbName,DBName:string;DSFrom:TDataset);是根据dataset新建一个表
CreateSQL(dsfrom :TDataSet) :string;是根据dataset生成创建表的sql
ExportTable(tbName,DBName:string;DSFrom:TDataset); 是把dataset中的数据导出到新建好的表中。
unit exportado;
interface
uses
  Variants,sysutils,ComObj,db,ADODB;
function  CreateSQL(dsfrom :TDataSet) :string;Procedure CreateTable(tbName,DBName:string;DSFrom:TDataset);procedure ExportTable(tbName,DBName:string;DSFrom:TDataset); procedure CreateDatabase(FName:string); implementation const
  adCmdUnspecified = $FFFFFFFF;
  adCmdUnknown = $00000008;
  adCmdText = $00000001;
  adCmdTable = $00000002;
  adCmdStoredProc = $00000004;
  adCmdFile = $00000100;
  adCmdTableDirect = $00000200;   adLockUnspecified = $FFFFFFFF;
  adLockReadOnly = $00000001;
  adLockPessimistic = $00000002;
  adLockOptimistic = $00000003;
  adLockBatchOptimistic = $00000004;   adOpenUnspecified = $FFFFFFFF;
  adOpenForwardOnly = $00000000;
  adOpenKeyset = $00000001;
  adOpenDynamic = $00000002;
  adOpenStatic = $00000003;   adEmpty = $00000000;
  adTinyInt = $00000010;
  adSmallInt = $00000002;
  adInteger = $00000003;
  adBigInt = $00000014;
  adUnsignedTinyInt = $00000011;
  adUnsignedSmallInt = $00000012;
  adUnsignedInt = $00000013;
  adUnsignedBigInt = $00000015;
  adSingle = $00000004;
  adDouble = $00000005;
  adCurrency = $00000006;
  adDecimal = $0000000E;
  adNumeric = $00000083;
  adBoolean = $0000000B;
  adError = $0000000A;
  adUserDefined = $00000084;
  adVariant = $0000000C;
  adIDispatch = $00000009;
  adIUnknown = $0000000D;
  adGUID = $00000048;
  adDate = $00000007;
  adDBDate = $00000085;
  adDBTime = $00000086;
  adDBTimeStamp = $00000087;
  adBSTR = $00000008;
  adChar = $00000081;
  adVarChar = $000000C8;
  adLongVarChar = $000000C9;
  adWChar = $00000082;
  adVarWChar = $000000CA;
  adLongVarWChar = $000000CB;
  adBinary = $00000080;
  adVarBinary = $000000CC;
  adLongVarBinary = $000000CD;
  adChapter = $00000088;
  adFileTime = $00000040;
  adDBFileTime = $00000089;
  adPropVariant = $0000008A;
  adVarNumeric = $0000008B; CCreateMDB='Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s';
function  CreateSQL(dsfrom :TDataSet) :string;
   var
    i:Integer;
    nome:string;
    SQL :string;
    fieldtype:string;
    datasize:Integer;
begin
     SQL:='CREATE TABLE %s ( ';
     dsfrom.Open;
    for i:=0 to dsfrom.FieldCount-1 do begin
      datasize:=0;
      nome:=dsfrom.Fields[i].FieldName;      case dsfrom.Fields[i].DataType  of
        ftString,ftWidestring  :
                    begin
                       FieldType:='CHAR';
                       datasize:=dsfrom.Fields[i].Size;
                    end;
        ftSmallInt:  begin
                       FieldType:= 'SMALLINT';
                     end;
        ftInteger :  begin
                       FieldType:= 'INTEGER';
                     end;
        ftWord    :  begin
                       FieldType:= 'SMALLINT ';
                     end;
        ftBoolean :  begin
                       FieldType:= 'BIT';
                     end;
        ftFloat   :  begin
                       FieldType:= 'Float';
                     end;
        ftCurrency:  begin
                       FieldType:= 'CURRENCY';
                     end;
        ftBCD     :  begin
                       FieldType:= 'DECIMAL';
                     end;
        ftDate    :  begin
                       FieldType:= 'DATE';
                     end;
        ftAutoInc : fieldtype:= 'AUTOINCREMENT';
        ftTime    :  begin
                       FieldType:= 'TIME' ;
                     end;
        ftDateTime:  begin
                       FieldType:= 'DATETIME';
                     end;
        ftBlob    :  begin
                       FieldType:= 'LONGBINARY';
                     end;
        ftBytes,ftVarBytes  :
                     begin
                       FieldType:= 'BINARY';
                     end;
        ftMemo,ftFmtMemo  :
                     begin
                       FieldType:= 'TEXT';
                     end;
        ftGraphic :  begin
                       FieldType:= 'IMAGE';
                     end;
        ftLargeint :  begin
                       FieldType:= 'LONG';
                      end;
        ftTimeStamp :  begin
                       FieldType:= 'DATETIME';
                      end;
        else
          Continue;
      end;
         if datasize<>0 then
            sql:=sql+nome+' '+FieldType+'('+IntToStr(Datasize)+')'
         else
            sql:=sql+nome+' '+FieldType;
         if i<>dsfrom.FieldCount-1 then
            sql:=sql+' , '
            else
            sql:=sql + ' );';
    end;
    Result:=sql;
  end;
Procedure CreateTable(tbName,DBName:string;DSFrom:TDataset);
var
  cat:variant;
  Cnn:variant;
  Cmd:Variant;
  sql:string;
begin
  Cnn:=CreateOleObject('ADODB.Connection');
  Cmd:=CreateOleObject('ADODB.Command');
  Cnn.Open(Format(CCreateMDB,[DBName]));
  Cmd.ActiveConnection:=Cnn;
  Cmd.CommandText:= Format(CreateSQL(DSFrom),[tbName]);
  sql:=Cmd.CommandText;
  Cmd.Execute();
end;procedure CreateDatabase(FName:string);
var
  cat:Variant;
begin
  cat:=CreateOleObject('ADOX.Catalog');
  cat.Create(Format(CCreateMDB,[fname]));
  cat:=Unassigned;
end;procedure ExportTable(tbName,DBName:string;DSFrom:TDataset);
var
  table:TADOTable;
  i:Integer;
begin
  table:=Tadotable.Create(nil);
  table.ConnectionString:= Format(CCreateMDB,[Dbname]);
  table.TableName:=tbname;
  table.Open();
  DsFrom.Open();
  Dsfrom.First();
  while not dsFrom.Eof do begin
    table.Append();
    for i:=0 to dsFrom.FieldCount-1 do begin
        if dsfrom.Fields[i].DataType=ftAutoInc then
        //    table.Fields[i].Value:='NULL'
        else
            table.Fields[i].Value:=dsFrom.Fields[i].Value;
    end;
    DsFrom.Next();
  table.Post();
  end;
  table.Close();
  table.Free();
end;
end.
以下是使用示例
把db1.mdb中的tb2、b1、B2三个表导出到test.mdb，如果要导出到已经存在的mdb文件中，就不用执行createdatabase了。
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, exportado, DB, ADODB, StdCtrls, Buttons, Grids, DBGrids,
  ExtCtrls, DBCtrls;type
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    Table1: TADOTable;
    Table2: TADOTable;
    Table3: TADOTable;
    ADOConnection1: TADOConnection;
    Memo1: TMemo;
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.BitBtn1Click(Sender: TObject);
var
  dbname,tbname:string;
begin
     table1.open;
  table2.open;
  table3.open;
begin
  dbname:='test.mdb';
{如果要导出到已经存在的mdb文件中，就不用执行以下三条语句了。}
  if FileExists(dbname) then
     DeleteFile(dbname);
  CreateDatabase(dbname);  memo1.Lines.Add(Format(CreateSQL(table1),['tb2']));
   memo1.Lines.Add(Format(CreateSQL(table2),['b1']));
  memo1.Lines.Add(Format(CreateSQL(table3),['b2']));  CreateTable('tb2',dbname,table1);
  CreateTable('b1',dbname,table2);
  CreateTable('b2',dbname,table3);  ExportTable('tb2',dbname,table1);
  ExportTable('b1',dbname,table2);
  ExportTable('b2',dbname,table3);  Beep;
  ShowMessage('Database exported to '+dbname);
end; end;end.

调试易

再问动态创建ACCESS数据库的问题

解决方案 »