如何将webbrowser 中的内容保存为Excel文件呀?

有一网页,例如格式如下:
http://219.142.101.91/jzqy/result.asp?sqls=select+%2A+from+chinabuild+&pageno=1&pp=下一页

用webbrowser 打开,如何将其保存成Excel文件呀?

请高手帮帮忙,急用

11 个解决方案

#1

1.右击选择“导出到MS Excel”
2.选中表格部分，赋值黏贴到Excel

#2

多谢,
我是说用程序如何做

#3

response.Clear();
            response.ContentType = "application/vnd.ms-excel";
            response.AddHeader("Content-Disposition", "attachment; filename=" + filename);
            response.Charset = "utf-8";
            response.ContentEncoding = Encoding.UTF8;
            StringWriter writer1 = new StringWriter();
            HtmlTextWriter writer2 = new HtmlTextWriter(writer1);
            grid.RenderControl(writer2);
            response.Write(writer1.ToString());
            response.End();

#4

http://www.chinaz.com/Program/Asp/0F6114H2007.html

#5

谢谢
vlysses(张家) 
的回复,
你所说的都是在服务器端执行.

我是需要自己写一个程序,在不知道网页服务器端的情况下,导出到Excel中的.

也就是说,不能使用asp等等,以及脚下本,

#6

自己写组件？

#7

有没有谁做过这方面的呀

#8

多谢各位，问题解决了

谢谢，问题解决了。
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, SHDocVw, ExtCtrls,MSHTML, ActiveX,comobj,
  StrUtils, DB, ADODB,UOperationData, ComCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    Edit3: TEdit;
    Label3: TLabel;
    Edit4: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    ADOConnection1: TADOConnection;
    ProgressBar1: TProgressBar;
    Label6: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure WebBrowser1DocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure FormShow(Sender: TObject);
  private
    procedure OutExcel(const WebBrowser:TWebBrowser); //导出为excel
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1       : TForm1;

  httpaddress1 :string;
  httpaddress2 :String;
  SumCount     :Integer;
  Count        : Integer;   //次数
  httpaddress  : String;
  od           :TOperationData;

implementation

{$R *.dfm}
function GetHtml(const WebBrowser:TWebBrowser): string;
const
  BufSize = $10000;
var
  Size: Int64;
  Stream: IStream;
  hHTMLText: HGLOBAL;
  psi: IPersistStreamInit;
begin
  if not Assigned(WebBrowser.Document) then Exit;
  OleCheck(WebBrowser.Document.QueryInterface(IPersistStreamInit, psi));
  try
    hHTMLText := GlobalAlloc(GPTR, BufSize);
    if 0 = hHTMLText then Exit;// RaiseLastWin32Error;
    OleCheck(CreateStreamOnHGlobal(hHTMLText, True, Stream));
    try
      OleCheck(psi.Save(Stream, False));
      Size := StrLen(PChar(hHTMLText));
      SetLength(Result, Size);
      CopyMemory(PChar(Result), Pointer(hHTMLText), Size);
    finally
      Stream := nil;
    end;
  finally
    psi := nil;
  end;
end;

procedure TForm1.OutExcel(const WebBrowser:TWebBrowser); //导出为excel
const
  //行列的分别起止
  rc = 12;
  rs = 31;
  cc = 1;
  cs = 9;
  str='EXCEL.EXE';
var
  Excelid      :variant;
  ri,ci        :Integer;  //当前行和当前列
  abc          :array[cc..cs] of string;
  sqlstr       :String;
  H            :THandle;
  P            :DWORD;
begin
  try
    Excelid:=CreateOleObject( 'Excel.Application' );
  except
    on Exception do raise exception.Create('无法创建Xls文件，请确认是否安装EXCEL')
  end;
  Excelid.Visible := False;
  Excelid.WorkBooks.Add;
  WebBrowser.ExecWB(OLECMDID_SELECTALL,OLECMDEXECOPT_DODEFAULT);
  WebBrowser.ExecWB(OLECMDID_COPY, OLECMDEXECOPT_DODEFAULT); //复制网页
  Excelid.worksheets[1].Paste; //excel文档粘贴
  WebBrowser.ExecWB(OLECMDID_UNDO, OLECMDEXECOPT_DODEFAULT); //取消全选

  for ri:= rc to rs do
  begin
    for ci:=cc to cs do
    begin
      abc[ci]:= Trim(AnsiReplaceText(Excelid.Cells[ri,ci].Value,'?',''));
    end;
    sqlstr:='Insert Into 技术监督局数据库(序号,获奖企业名称,'+
             '品种规格,许可证编号,有效日期,发证日期,说明,地区,附件'+
             ') Values ('+QuotedStr(abc[1])+','+QuotedStr(abc[2])+
             ','+QuotedStr(abc[3])+','+QuotedStr(abc[4])+','
             +QuotedStr(abc[5])+','+QuotedStr(abc[6])+','
             +QuotedStr(abc[7])+','+QuotedStr(abc[8])+','
             +QuotedStr(abc[9])+')';
//    ShowMessage(sqlstr);
    if not od.SetExecSql(sqlstr) then
    begin
       od.SetExecSql('Insert into 日志表(日志) values ('
                  +QuotedStr('系统在取第'+inttostr(Count)+'页时遇到错误！')+')');
       Break;
    end;
    ProgressBar1.StepIt;
  end;

  Excelid.ActiveWorkBook.Saved := True;
  Excelid.WorkBooks.Close;
  Excelid.quit;

 //杀死进程 
  H:=FindWindow(nil,pchar(Str));
  if H<>0 then 
  begin 
    GetWindowThreadProcessId(H,@P); 
    if P<>0 then 
      TerminateProcess(OpenProcess(PROCESS_TERMINATE,False,P),$FFFFFFFF); 
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ProgressBar1.Max:= SumCount;
  ProgressBar1.Min:= Count;

  httpaddress1:=Edit1.Text;
  httpaddress2:=Edit2.Text;
  Count:=StrToIntDef(Edit3.Text,1);
  SumCount:=StrToIntDef(Edit4.Text,1);

  httpaddress:=httpaddress1+inttostr(Count)+httpaddress2;
  WebBrowser1.Navigate(httpaddress);
  M_Bool:=True;
end;

procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject;
  const pDisp: IDispatch; var URL: OleVariant);
begin
  Label6.Caption:=IntToStr(count);
  if Count < SumCount then
  begin
  //  htmlstr:= GetHtml(WebBrowser1);  //取得HTML源代码
    OutExcel(WebBrowser1);
    Inc(Count);
    httpaddress:=httpaddress1+inttostr(Count)+httpaddress2;
    WebBrowser1.Navigate(httpaddress);
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  od:= TOperationData.Create(ADOConnection1);
end;

initialization
    OleInitialize(nil);
  finalization
  try
    OleUninitialize;
  except
  end;

end.

#9

要分的过来，接贴了

#10

前面的数据提取会了吧?

  Dim Xlapp As Object

          Dim Header As String
          Dim xlsheet As Excel.Worksheet
          Set Xlapp = CreateObject("excel.application")
          
          
          Xlapp.Workbooks.Add
          Xlapp.Visible = True
          Set xlsheet = Xlapp.Worksheets.Add

for i=0 to list1.listcount

   list1.listindex=i

   With xlsheet
          
             Cells(i, 2) = List1.Text
                       
     End With

next i


          Set xlsheet = Nothing
          Set Xlapp = Nothing

#11

ok