Delphi, Export Html Table To Excel

All I want to do is to implement 'Export to excel' option of a classical webbrowser, to Delphi2007 commands...... When I am using this option from a webbrowser to export a 12000 ro

Solution 1:

I found the solution...HTML Table Parsing in Less than a second!

function HTMLCleanUp(L : string) : string;
var
P1,P2 : integer;
begin
P1 := Pos('<',L); //clean-up anything between <>
while (P1>0) do    //WHILE1
begin
P2 := Pos('>',L);
if (P2>0)
then Begin Delete(L,P1,P2-P1+1); end;
P1 := Pos('<',L);
end;               //WHILE1
L:=StringReplace(L,'&nbsp;','-',[rfReplaceAll]);
Result := Trim(L);
end;

 procedure TForm11.WB_SaveAs_HTML(WB : TWebBrowser; const FileName : string) ;
 var
   PersistStream: IPersistStreamInit;
   Stream: IStream;
   FileStream: TFileStream;
 begin
   if not Assigned(WB.Document) then
   begin
     ShowMessage('Document not loaded!') ;
     Exit;
   end;

   PersistStream := WB.Document as IPersistStreamInit;
   FileStream := TFileStream.Create(FileName, fmCreate) ;
   try
     Stream := TStreamAdapter.Create(FileStream, soReference) as IStream;
     if Failed(PersistStream.Save(Stream, True)) then ShowMessage('SaveAs HTML fail!') ;
   finally
     FileStream.Free;
   end;
 end; (* WB_SaveAs_HTML *)

procedure TForm11.Button1Click(Sender: TObject);
const
xlExcel7 = $00000027;
TmpFileName='c:\test\xxxx.txt';
CRLF = #13#10;
CSVTempSeparator = #9;   //#255; //replaced by a comma
ADPNEWHOTURL = 'http://samples.msdn.microsoft.com/workshop/samples/author/tables/HTML_Table.htm';

VAR
Excel, WS: Olevariant;
P1,P2,P3,P4, p5, P6, p11, p22 : integer;
i, j: Integer;
buffer,rawHTM,TmpStr,CSVStr:string;
HTMFile : TextFile;
CSVSTRList : TStringList;

begin
CSVSTRList := TStringList.Create;

WB_SaveAs_HTML(WebBrowser1,TmpFileName) ;

AssignFile(HTMFile, TmpFileName);//read the HTML file
     Reset(HTMFile);
        while not EOF(HTMFile) do begin
        ReadLn(HTMFile, buffer);
        rawHTM := Concat(rawHTM, buffer);
      end;

i:=1;j:=1;
rawHTM := Trim(StringReplace(rawHTM,CRLF,'',[rfReplaceAll]));
P1 := PosEx('<TR',rawHTM, 1);   //CASE SENSITIVE , TR->FIRST ROW
while (P1>0) do     //while1
begin
P2 := PosEx('</TR',rawHTM, P1);
      if (P2>0)      //if1
      then begin
      TmpStr := Copy(rawHTM,P1,P2-P1+1);
      CSVStr := '';p11:=1;p22:=1;
      P11 := PosEx('<TH',TmpStr,1);
            while (P11>0) do   //while2
            begin
            P22 := PosEx('</TH',TmpStr, P11);
                   if (P22>0)  //if2
                   then begin
                   CSVStr :=CSVStr+
                   HTMLCleanUp(Trim(Copy(TmpStr,P11,P22-P11)))+CSVTempSeparator; j:=j+1;
                   end        //if2
                   else begin
                   Exit;
                   end;       //if2
            P11 := PoseX('<TH',TmpStr, P22);
            end;              //while2
       P11 := PosEx('<TD',TmpStr, 1);
            while (P11>0) do   //while2
            begin
            P22 := PosEx('</TD',TmpStr, P11);
                   if (P22>0)  //if2
                   then begin
                   CSVStr :=CSVStr+
                   HTMLCleanUp(Trim(Copy(TmpStr,P11,P22-P11)))+CSVTempSeparator; j:=j+1;
                   end        //if2
                   else begin
                   Exit;
                   end;       //if2
             P11 := PosEx('<TD',TmpStr,P22);
            end;              //while2
      end            //if1
      else begin
      exit;
      end;            //if1
      CSVSTRList.Add(CSVStr);
P1 := PosEx('<TR',rawHTM,P2); i:=i+1; j:=1;  //CASE SENSITIVE
end;      //while1

CSVSTRList.SaveToFile('c:\test\xxx2.txt');
Excel:= CreateOleObject('Excel.Application');
Excel.WorkBooks.opentext('c:\test\xxx2.txt');//OPEN TXT WITH EXCEL
Excel.visible := True;
CloseFile(HTMFile);
DeleteFile(TmpFileName);
end;