字符串存成excel表范例

最新推荐文章于 2024-03-27 10:14:50 发布

chinajobs

最新推荐文章于 2024-03-27 10:14:50 发布

阅读量722

点赞数

CC 4.0 BY-SA版权

分类专栏： Delphi 文章标签： excel

本文链接：https://blog.youkuaiyun.com/chinajobs/article/details/51057883

Delphi 专栏收录该内容

150 篇文章

订阅专栏

本文介绍了一种使用Delphi从多个HTML文件中提取表格数据，并将其转换为Microsoft Excel格式的方法。该过程涉及读取HTML文件、解析表格内容、确定不同类型的表格结构并最终将数据导出到Excel工作簿。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

var
Files, FileCon, Emails, Recs: TStrings;
i,j,typeid, startIndex: Integer;
filename, OneRec: string;
TextStr, username,realname, phone, email, xlsFileName: string;
eclApp, WorkBook: Variant; {声明为OLE Automation对象}
begin
typeid := 0;
if Trim(edtFileName.Text) = '' then
begin
Application.MessageBox('请先选择待提取文件存放路径！', '提示', MB_OK + MB_ICONINFORMATION);
Exit;
end;

if Trim(edtSavePath.Text) = '' then
begin
Application.MessageBox('请先选择提示内容保存路径！', '提示', MB_OK + MB_ICONINFORMATION);
Exit;
end;

Files := TStringList.Create;
FileCon := TStringList.Create;
Recs := TStringList.Create;
try
ListFiles(Trim(edtFileName.Text), '*', Files);
for i := 0 to Files.Count - 1 do
begin
try
{创建OLE对象：Excel Application与WordBook}
eclApp := CreateOleObject('Excel.Application');
WorkBook := CreateOleObject('Excel.Sheet');
except
Application.MessageBox('你的机器没有安装Microsoft Excel', '使用Microsoft Excel', MB_OK + MB_ICONWarning);
Exit;
end;
Gauge.MaxValue := Files.Count;
FileCon.Clear;
filename := Files.Strings[i];
FileCon.LoadFromFile(filename);
TextStr := xQuery2(FileCon.Text, 'table','id=editProduct');
if TextStr = '' then
begin
TextStr := xGet(FileCon.Text, 'table[class="font12"][2]');
typeid := 1;
end;
if TextStr = '' then
begin
TextStr := xQuery2(FileCon.Text, 'table','class="m_tab"');
typeid := 2;
end;
recs.Clear;
xQuery2(TextStr, 'tr', '', recs);
if recs.Count > 1 then
begin
try
WorkBook := eclApp.workbooks.Add;
EclApp.Cells(1, 1) := '用户名';
EclApp.Cells(1, 2) := '真实姓名';
EclApp.Cells(1, 3) := '手机号码';
EclApp.Cells(1, 4) := '邮箱';
if typeid=2 then startIndex :=3
else startIndex :=1;
for j := startIndex to recs.Count - 1 do
begin
OneRec := recs[j];
if typeid=0 then
begin
username := xGet(OneRec, 'td[][0]');
username := Trim(HtmlToTxt(xGet(username, 'a')));
realname := xGet(OneRec, 'td[][1]');
realname := Trim(HtmlToTxt(xGet(realname, 'a')));
phone := xGet(OneRec, 'td[][5]');
phone := Trim(HtmlToTxt(xGet(phone, 'a')));
email := xGet(OneRec, 'td[][5]');
email := FastReplace(email, xGet(email, 'a'), '');
email := Trim(HtmlToTxt(email));
end
else if typeid=1 then
begin
username := xGet(OneRec, 'td[][1]');
username := Trim(HtmlToTxt(xGet(username, 'a')));
realname := xGet(OneRec, 'td[][3]');
realname := Trim(HtmlToTxt(xGet(realname, 'a')));
phone := xGet(OneRec, 'td[][6]');
phone := Trim(HtmlToTxt(xGet(phone, 'a')));
email := xGet(OneRec, 'td[][6]');
email := FastReplace(email, xGet(email, 'a'), '');
email := Trim(HtmlToTxt(email));
end
else if typeid=2 then
begin
username := xGet(OneRec, 'td[][1]');
username := Trim(HtmlToTxt(xGet(username, 'font')));
realname := xGet(OneRec, 'td[][5]');
realname := xGet(realname, 'input[][]');
realname := xGetAttrValue(realname, 'value');
phone := xGet(OneRec, 'td[][4]');
phone := xGet(phone, 'input[][]');
phone := xGetAttrValue(phone, 'value');
// email := xGet(OneRec, 'td[][5]');
// email := FastReplace(email, xGet(email, 'input[][]'), '');
// email := Trim(HtmlToTxt(email));
end;

EclApp.Cells((j - startIndex) + 2, 1) := username;
EclApp.Cells((j - startIndex) + 2, 2) := UTF8Decode(realname);
EclApp.Cells((j - startIndex) + 2, 3) := phone;
EclApp.Cells((j - startIndex) + 2, 4) := email;
end;
xlsFileName := trim(edtSavePath.Text);
if RightStr(xlsFileName, 1) <> '\' then
xlsFileName := xlsFileName + '\';
xlsFileName := xlsFileName + ExtractFileName(filename);
xlsFileName := ChangeFileExt(xlsFileName, '.xls');
if FileExists(xlsFileName) then DeleteFile(xlsFileName);
WorkBook.SaveAS(xlsFileName);
WorkBook.Close;
EclApp.Quit; //退出Excel Application
{释放Variant变量}
eclApp := Unassigned;
except
ShowMessage('不能正确操作Excel文件。可能是该文件已被其他程序打开，或系统错误。');
WorkBook.Close;
EclApp.Quit;
{释放Variant变量}
eclApp := Unassigned;
end;

end;
Gauge.Progress := i + 1;
application.ProcessMessages;
end;
showMessage('ok');
finally
Files.Free;
FileCon.Free;
Recs.Free;
end;
end;