Mega Code Archive
How to export a Table with all or selected Fields
<![CDATA[
Title: How to export a Table with all or selected Fields
Question: You will export all Tabledatas to an Textfile?
Or you will export selected Fields to an Textfile?
Answer:
First Sample.
This procedure exports all Tabledatas to an Textfile:
procedure TForm1.ExportDB(InputTableName, OutputFileName,
FieldDelimiter: string; Header: Boolean);
{ Parameters:
InputTableName = full Name and Path of Inputtable
OutputFileName = full Name and Path of Outputfile
FieldDelimiter = Delimiterchar (e.g. ; | )
Header = True writes an Header with the fieldnames on the first line
}
var
F: TextFile;
I, IX: Integer;
OutRec: string;
TempTbl: TTable;
begin
try
AssignFile(F, OutputFileName);
Rewrite(F);
except
on E: EInOutError do
ShowMessage('Openerror: ' + E.Message);
end;
TempTbl := TTable.Create(nil);
with TempTbl do begin
try
TableName := InputTableName;
Open;
except
on E: EDataBaseError do begin
ShowMessage('Openerror: ' + E.Message);
end;
end;
OutRec := '';
for IX := 0 to FieldCount - 1 do
OutRec := OutRec + Fields[IX].FieldName + FieldDelimiter;
if (Header = True) then begin
WriteLn(F, Copy(OutRec, 1, Length(OutRec) - 1));
end;
while not EOF do begin
OutRec := '';
for IX := 0 to FieldCount - 1 do
OutRec := OutRec + Fields[IX].AsString + FieldDelimiter;
WriteLn(F, Copy(OutRec, 1, Length(OutRec) - 1));
Next;
end;
close;
end;
CloseFile(F);
end;
an here is the code for the Dialog-Button:
procedure TForm1.Button1Click(Sender: TObject);
var
OutputFileName, FieldDelimiter, InputTable: string;
begin
InputTable := InputBox('Table to be exported',
'give Name and Path ',
'c:\Programme\Gemeinsame Dateien\Borland Shared\Data\Customer.db');
OutputFileName := InputBox('OutputFile',
'give Name and Path ',
'c:\Temp\Output.txt');
FieldDelimiter := InputBox('Field Delimiter',
'give the Delimiterchar ', ';');
ExportDB(InputTable, OutputFileName, trim(FieldDelimiter), True);
ShowMessage('Export ended. Outputfile is : ' + OutputFileName);
end;
Second Sample.
This procedure exports selected fields only from an Table to an Textfile:
const
FNames: array[0..6] of string =
('CustNo', 'Company', 'Addr1', 'Addr2', 'City', 'Phone', 'Fax');
procedure TForm1.ExportDBX(InputTableName, OutputFileName,
FieldDelimiter: string; Header: Boolean; FNames: array of string);
{
Parameters:
InputTableName = full Name and Path of Inputtable
OutputFileName = full Name and Path of Outputfile
FieldDelimiter = Delimiterchar (e.g. ; | )
Header = True writes an Header with the fieldnames on the first line
The Fieldnames to be exported must be passed in Array FNames.
}
var
F: TextFile;
I, IX: Integer;
OutRec: string;
TempTbl: TTable;
begin
try
AssignFile(F, OutputFileName);
Rewrite(F);
except
on E: EInOutError do
ShowMessage('Openerror: ' + E.Message);
end;
TempTbl := TTable.Create(nil);
with TempTbl do begin
try
TableName := InputTableName;
Open;
except
on E: EDataBaseError do begin
ShowMessage('Openerror: ' + E.Message);
end;
end;
OutRec := '';
for I := 0 to Length(FNames) - 1 do begin
if (FNames[I] = '') then break;
OutRec := OutRec + FNames[i] + FieldDelimiter;
end;
if (Header = True) then begin
WriteLn(F, Copy(OutRec, 1, Length(OutRec) - 1));
end;
while not EOF do begin
OutRec := '';
for IX := 0 to Length(FNames) - 1 do
OutRec := OutRec + FieldByName(FNames[IX]).AsString + FieldDelimiter;
WriteLn(F, Copy(OutRec, 1, Length(OutRec) - 1));
Next;
end;
close;
end;
CloseFile(F);
ShowMessage('Export ended. Outputfile is : ' + OutputFileName);
end;
an here is the code for the Dialog-Button:
procedure TForm1.Button2Click(Sender: TObject);
var
OutputFileName, FieldDelimiter, InputTable: string;
begin
InputTable := 'c:\Programme\Gemeinsame Dateien\Borland Shared\Data\Customer.db';
OutputFileName := 'c:\Temp\Output.txt';
FieldDelimiter := ';';
ExportDBX(InputTable, OutputFileName, FieldDelimiter, True, FNames);
end;
end.
Sample Outputfile from ExportDBX():
CustNo;Company;Addr1;Addr2;City;Phone;Fax
1221;Kauai Dive Shoppe;4-976 Sugarloaf Hwy;Suite 103;Kapaa Kauai;808-555-0269;808-555-0278
1231;Unisco;PO Box Z-547;;Freeport;809-555-3915;809-555-4958
1351;Sight Diver;1 Neptune Lane;;Kato Paphos;357-6-876708;357-6-870943
]]>