Dev Express 中的 dxDBGrid/cxGrid 均提供了将表格中 数据 导出 到 M$ Excel 等中的方法，但大多时候，却需将 数据 导出 至 M$ Access 中... 于是便有了本文。 uses ComObj, Gauges, ShellAPI; const ExportTabName_MDB = '营销 数据 '; MDBStr = 'Provider=
Dev Express 中的 dxDBGrid/cxGrid 均提供了将表格中数据导出到 M$ Excel 等中的方法，但大多时候，却需将数据导出至 M$ Access 中... adelphicoder 一个功能强大、性能卓越的企业建站系统。使用静态网页技术大大减轻了服务器负担、加快网页的显示速度、提高搜索引擎推广效果。本系统的特点自定义模块多样化、速度快、占用服务器资源小、扩展性强，能方便快捷地建立您的企业展示平台。简便高效的管理操作从用户使用的角度考虑，对功能的操作方便性进行了设计改造。使用户管理的工作量减小。网站互动数据可导出Word文档，邮件同步发送功能可将互动信息推送到指定邮箱，加快企业
于是便有了本文。
uses
ComObj, Gauges, ShellAPI;
const
ExportTabName_MDB = '营销数据';
MDBStr = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s';
var
ExportName: string;
ExportColumnLst: TStringList; //列名;列类型(长度)
begin
ExportName:= '导出结果.MDB'; //use a SaveDialog to select the save name here
ExportColumnLst:= TStringList.Create;
//（示例）导出列列表，注意 格式
ExportColumnLst.Add('Contact;联系人 varchar(30)');
ExportColumnLst.Add('Gender;性别 varchar(2)');
ExportColumnLst.Add('Address;地址 varchar(100)');
ExportColumnLst.Add('PostCode;邮编 varchar(6)');
try
ExportToMDB(ExportName, ExportColumnLst);
finally
FreeAndNil(ExportColumnLst);
end;
end;
procedure ExportToMDB(ExportMDBName: string; ExportColumnLst);
function CreateMDB(MDBFileName: string): Boolean;
var
vMDB: Variant;
begin
Result:= False;
vMDB:= CreateOleObject('ADOX.Catalog');
vMDB.Create(Format(MDBStr, [MDBFileName]));
vMDB:= UnAssigned;
Result:= True;
end;
function CreateTab(MDBAndTabName: string; ExportColumnLst: TStringList;
aqy_ExecSQL: TADOQuery): Boolean;
var
i: Integer;
StrTmp: string;
SQLTxt: string;
MDBName: string;
TabName: string;
begin
Result:= False;
SQLTxt:= '';
for i:= 0 to ExportColumnLst.Count - 1 do
begin
StrTmp:= ExportColumnLst.Strings
if SQLTxt = '' then
SQLTxt:= Copy(StrTmp, Pos(';', StrTmp) + 1, Length(StrTmp));
else
SQLTxt:= SQLTxt + ',' +
Copy(StrTmp, Pos(';', StrTmp) + 1, Length(StrTmp));
end;
MDBName:= Copy(MDBAndTabName, 1, Pos(';', MDBAndTabName) - 1);
TabName:= Copy(
MDBAndTabName,
Pos(';', MDBAndTabName) + 1,
Length(MDBAndTabName)
);
with aqy_ExecSQL do
try
Close;
ConnectionString:=
'Provider=MSDataShape.1;Data Provider=Microsoft.Jet.OLEDB.4.0;' +
'Data Source=' + MDBName + ';Persist Security Info=false';
SQL.Text:=
'create table ' + TabName +
'(' +
SQLTxt +
')';
try
ExecSQL;
Close;
except
on E: Exception do
begin
MessageBox(
Handle,
PChar('创建表失败！' + #13 + '失败原因：' + E.Message),
'错误',
MB_OK + MB_ICONERROR
);
Close;
Exit;
end;
end;
finally
//Free;
end;
Result:= True;
end;
var
aqy_ExecSQL: TADOQuery;
SQLTxt: string;
i: Integer;
StrTmp: string;
ExportColumn: string;
ExportColumnParam: string;
ExportParamLst: TStringList;
GgTip: TGauge;
CurrRec: Integer;
begin
if CreateMDB(ExportMDBName) then
begin
aqy_ExecSQL:= TADOQuery.Create(Self);
try
if CreateTab(
ExportMDBName + ';' + ExportTabName_MDB,
ExportColumnLst,
aqy_ExecSQL
) then
begin
Screen.Cursor:= crHourGlass;
ExportColumn:= '';
ExportColumnParam:= '';
ExportParamLst:= TStringList.Create;
for i:= 0 to ExportColumnLst.Count - 1 do
begin
StrTmp:= ExportColumnLst.Strings
if ExportColumn = '' then
begin
ExportColumn:= Copy(StrTmp, 1, Pos(';', StrTmp) - 1);
ExportColumnParam:= ':' + ExportColumn;
ExportParamLst.Add(ExportColumn);
end
else
begin
ExportColumn:= ExportColumn + ',' +
Copy(StrTmp, 1, Pos(';', StrTmp) - 1);
ExportColumnParam:= ExportColumnParam + ',:' +
Copy(StrTmp, 1, Pos(';', StrTmp) - 1);
ExportParamLst.Add(Copy(StrTmp, 1, Pos(';', StrTmp) - 1));
end;
end;
SQLTxt:=
'select ' + ExportColumn + ' from TabName where ID=' +
aqy_Tmp1.FieldByName('ID').AsString;
try
with aqy_ExportData do //aqy_ExportData: TADOQuery;
begin
Close;
SQL.Text:= SQLTxt;
Open;
//pnl_ExportFile: TPanel;
GgTip:= TGauge.Create(pnl_ExportFile); //Gauge 进度提示
with GgTip do
begin
Parent:= pnl_ExportFile;
Left:= 0;
Height:= 21;
Width:= pnl_ExportFile.Width;
ForeColor:= clFuchsia;
MinValue:= 0;
MaxValue:= RecordCount;
Visible:= True;
Update;
end;
CurrRec:= 0;
while not Eof do
begin
Inc(CurrRec);
if CurrRec mod 20 = 0 then
begin
GgTip.Progress:= CurrRec;
Update;
Application.ProcessMessages;
end;
with aqy_ExecSQL do
begin
Close;
SQL.Text:=
'Insert Into ' + ExportTabName_MDB +
' Values(' + ExportColumnParam + ')';
for i:= 0 to ExportParamLst.Count - 1 do
Parameters.ParamByName(ExportParamLst.Strings
aqy_ExportData.FieldByName(
ExportParamLst.Strings
).AsString;
try
ExecSQL;
except
on E: Exception do
begin
Close;
GgTip.Visible:= False;
Update;
MessageBox(
Handle,
PChar('导出文件失败！ ' + #13 + '失败原因：' +
E.Message + ' '
),
'错误',
MB_OK + MB_ICONERROR
);
Exit;
end;
end;
end; //End with
aqy_ExecSQL.Close;
Next;
end; //End while
Close; //aqy_ExportData
GgTip.Visible:= False;
if MessageBox(
Handle,
PChar('导出文件成功！ ' + #13 +
'现在查看导出结果（' + ExportMDBName + '吗？'
),
'提示',
MB_YESNO + MB_ICONINFORMATION
) = IDYES then
begin
ShellExecute(0, 'Open', PChar(ExportMDBName), nil, nil, SW_SHOW);
end;
end;
except
on E: Exception do
begin
pnl_ExportFile.Caption:= '';
GgTip.Visible:= False;
Update;
MessageBox(
Handle,
PChar('导出文件过程中发生错误！ ' + #13 +
'错误描述：' + E.Message + ' '
),
'导出失败',
MB_OK + MB_ICONERROR
);
end;
end;
end;
finally
FreeAndNil(aqy_ExecSQL);
FreeAndNil(ExportParamLst);
FreeAndNil(GgTip);
Screen.Cursor:= crDefault;
end;
end;
end;
OK，Done！ 
