WEB报表导出word,excel文件?

[hmz998]

怎样将SQL语查询出来的报表导出为word,excel文件?在贴子上看的代码都不行,EXCEL的application组件在用时提示缺少对像,owc组件代码运行时超时无提示,请大侠们帮忙?今天必须解决的问题

[hmz998]

上面的代码没用啊，我不是说了吗

[尚和空四]

导出到Word代码
printcode = printCode & "</table>"
%>
<%
filepath="printtemp"
fname="print.doc"
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Set fout = fso.CreateTextFile(server.mappath(filePath& "\" & fname))
fout.WriteLine printcode
fout.close

[hfkj]

一、使用OWC

　　什么是OWC？

　　OWC是Office Web Compent的缩写，即Microsoft的Office Web组件，它为在Web中绘制图形提供了灵活的同时也是最基本的机制。在一个intranet环境中，如果可以假设客户机上存在特定的浏览器和一些功能强大的软件（如IE5和Office 2000），那么就有能力利用Office Web组件提供一个交互式图形开发环境。这种模式下，客户端工作站将在整个任务中分担很大的比重。

＜%Option Explicit
Class ExcelGen
Private objSpreadsheet
Private iColOffset

Private iRowOffset
Sub Class_Initialize()
Set objSpreadsheet = Server.CreateObject("OWC.Spreadsheet")
iRowOffset = 2
iColOffset = 2
End Sub

Sub Class_Terminate()
Set objSpreadsheet = Nothing 'Clean up
End Sub

Public Property Let ColumnOffset(iColOff)
If iColOff ＞ 0 then
iColOffset = iColOff
Else
iColOffset = 2
End If
End Property

Public Property Let RowOffset(iRowOff)
If iRowOff ＞ 0 then
iRowOffset = iRowOff
Else
iRowOffset = 2
End If
End Property Sub GenerateWorksheet(objRS)
'Populates the Excel worksheet based on a Recordset's contents
'Start by displaying the titles
If objRS.EOF then Exit Sub
Dim objField, iCol, iRow
iCol = iColOffset
iRow = iRowOffset
For Each objField in objRS.Fields
objSpreadsheet.Cells(iRow, iCol).Value = objField.Name
objSpreadsheet.Columns(iCol).AutoFitColumns
'设置Excel表里的字体
objSpreadsheet.Cells(iRow, iCol).Font.Bold = True
objSpreadsheet.Cells(iRow, iCol).Font.Italic = False
objSpreadsheet.Cells(iRow, iCol).Font.Size = 10
objSpreadsheet.Cells(iRow, iCol).Halignment = 2 '居中
iCol = iCol + 1
Next 'objField
'Display all of the data
Do While Not objRS.EOF
iRow = iRow + 1
iCol = iColOffset
For Each objField in objRS.Fields
If IsNull(objField.Value) then
objSpreadsheet.Cells(iRow, iCol).Value = ""
Else
objSpreadsheet.Cells(iRow, iCol).Value = objField.Value
objSpreadsheet.Columns(iCol).AutoFitColumns
objSpreadsheet.Cells(iRow, iCol).Font.Bold = False
objSpreadsheet.Cells(iRow, iCol).Font.Italic = False
objSpreadsheet.Cells(iRow, iCol).Font.Size = 10
End If
iCol = iCol + 1
Next 'objField
objRS.MoveNext
Loop
End Sub Function SaveWorksheet(strFileName)

'Save the worksheet to a specified filename
On Error Resume Next
Call objSpreadsheet.ActiveSheet.Export(strFileName, 0)
SaveWorksheet = (Err.Number = 0)
End Function
End Class

Dim objRS
Set objRS = Server.CreateObject("ADODB.Recordset")
objRS.Open "SELECT * FROM xxxx", "Provider=SQLOLEDB.1;Persist Security

Info=True;User ID=xxxx;Password=xxxx;Initial Catalog=xxxx;Data source=xxxx;"
Dim SaveName
SaveName = Request.Cookies("savename")("name")
Dim objExcel
Dim ExcelPath
ExcelPath = "Excel\" & SaveName & ".xls"
Set objExcel = New ExcelGen
objExcel.RowOffset = 1
objExcel.ColumnOffset = 1
objExcel.GenerateWorksheet(objRS)
If objExcel.SaveWorksheet(Server.MapPath(ExcelPath)) then
'Response.Write "＜html＞＜body bgcolor='gainsboro' text='#000000'＞已保存为Excel文件.

＜a href='" & server.URLEncode(ExcelPath) & "'＞下载＜/a＞"
Else
Response.Write "在保存过程中有错误!"
End If
Set objExcel = Nothing
objRS.Close
Set objRS = Nothing
%＞

　　二、用Excel的Application组件在客户端导出到Excel或Word

　　注意：两个函数中的“data“是网页中要导出的table的 id

＜input type="hidden" name="out_word" onclick="vbscript:buildDoc" value="导出到word" class="notPrint"＞
＜input type="hidden" name="out_excel" onclick="AutomateExcel();" value="导出到excel" class="notPrint"＞

　　导出到Excel代码

＜SCRIPT LANGUAGE="javascript"＞
＜!--
function AutomateExcel()
{
// Start Excel and get Application object.
var oXL = new ActiveXObject("Excel.Application");
// Get a new workbook.
var oWB = oXL.Workbooks.Add();
var oSheet = oWB.ActiveSheet;
var table = document.all.data;
var hang = table.rows.length;

var lie = table.rows(0).cells.length;

// Add table headers going cell by cell.
for (i=0;i＜hang;i++)
{
for (j=0;j＜lie;j++)
{
oSheet.Cells(i+1,j+1).value = table.rows(i).cells(j).innerText;
}

}
oXL.Visible = true;
oXL.UserControl = true;
}
//--＞
＜/SCRIPT＞

　　导出到Word代码

＜script language="vbscript"＞
Sub buildDoc
set table = document.all.data
row = table.rows.length
column = table.rows(1).cells.length

Set objWordDoc = CreateObject("Word.Document")

objWordDoc.Application.Documents.Add theTemplate, False
objWordDoc.Application.Visible=True

Dim theArray(20,10000)
for i=0 to row-1
for j=0 to column-1
theArray(j+1,i+1) = table.rows(i).cells(j).innerTEXT
next
next
objWordDoc.Application.ActiveDocument.Paragraphs.Add.Range.InsertBefore("综合查询结果集") //显示表格标题

objWordDoc.Application.ActiveDocument.Paragraphs.Add.Range.InsertBefore("")
Set rngPara = objWordDoc.Application.ActiveDocument.Paragraphs(1).Range
With rngPara
.Bold = True //将标题设为粗体
.ParagraphFormat.Alignment = 1 //将标题居中
.Font.Name = "隶书" //设定标题字体
.Font.Size = 18 //设定标题字体大小
End With
Set rngCurrent = objWordDoc.Application.ActiveDocument.Paragraphs(3).Range
Set tabCurrent = ObjWordDoc.Application.ActiveDocument.Tables.Add(rngCurrent,row,column)

for i = 1 to column

objWordDoc.Application.ActiveDocument.Tables(1).Rows(1).Cells(i).Range.InsertAfter theArray(i,1)
objWordDoc.Application.ActiveDocument.Tables(1).Rows(1).Cells(i).Range.ParagraphFormat.alignment=1
next
For i =1 to column
For j = 2 to row
objWordDoc.Application.ActiveDocument.Tables(1).Rows(j).Cells(i).Range.InsertAfter theArray(i,j)
objWordDoc.Application.ActiveDocument.Tables(1).Rows(j).Cells(i).Range.ParagraphFormat.alignment=1
Next
Next

End Sub
＜/SCRIPT＞

　　三、直接在IE中打开，再存为EXCEL文件

　　把读出的数据用＜table＞格式，在网页中显示出来，同时，加上下一句即可把EXCEL表在客客户端显示。

＜%response.ContentType ="application/vnd.ms-excel"%＞

　　注意：显示的页面中，只把＜table＞输出，最好不要输出其他表格以外的信息。

　　四、导出以半角逗号隔开的csv

　　用fso方法生成文本文件的方法，生成一个扩展名为csv文件。此文件，一行即为数据表的一行。生成数据表字段用半角逗号隔开。（有关fso生成文本文件的方法，在此就不做介绍了）

　　CSV文件介绍 （逗号分隔文件）

　　选择该项系统将创建一个可供下载的CSV 文件； CSV是最通用的一种文件格式，它可以非常容易地被导入各种PC表格及数据库中。

　　请注意即使选择表格作为输出格式，仍然可以将结果下载CSV文件。在表格输出屏幕的底部，显示有 "CSV 文件"选项，点击它即可下载该文件。

　　如果您把浏览器配置为将您的电子表格软件与文本（TXT）/逗号分隔文件（CSV） 相关联，当您下载该文件时，该文件将自动打开。下载下来后，如果本地已安装EXCEL，点击此文件，即可自动用EXCEL软件打开此文件。

[hawk2004]

搜索一下，会有很多的了

[kkkbs]

你建一个table ，让其id为data

下面是导出到Word代码：
<input type="hidden" name="out_word" onclick="vbscript:buildDoc" value="导出到word" class="notPrint">
<script language="vbscript">
Sub buildDoc
set table = document.all.data
row = table.rows.length
column = table.rows(1).cells.length

Set objWordDoc = CreateObject("Word.Document")

'objWordDoc.Application.Documents.Add theTemplate, False
objWordDoc.Application.Visible=True

Dim theArray(20,10000)
for i=0 to row-1
for j=0 to column-1
theArray(j+1,i+1) = table.rows(i).cells(j).innerTEXT
next
next
objWordDoc.Application.ActiveDocument.Paragraphs.Add.Range.InsertBefore("综合查询结果集") //显示表格标题

objWordDoc.Application.ActiveDocument.Paragraphs.Add.Range.InsertBefore("")
Set rngPara = objWordDoc.Application.ActiveDocument.Paragraphs(1).Range
With rngPara
.Bold = True //将标题设为粗体
.ParagraphFormat.Alignment = 1 //将标题居中
.Font.Name = "隶书" //设定标题字体
.Font.Size = 18 //设定标题字体大小
End With
Set rngCurrent = objWordDoc.Application.ActiveDocument.Paragraphs(3).Range
Set tabCurrent = ObjWordDoc.Application.ActiveDocument.Tables.Add(rngCurrent,row,column)

for i = 1 to column

objWordDoc.Application.ActiveDocument.Tables(1).Rows(1).Cells(i).Range.InsertAfter theArray(i,1)
objWordDoc.Application.ActiveDocument.Tables(1).Rows(1).Cells(i).Range.ParagraphFormat.alignment=1
next
For i =1 to column
For j = 2 to row
objWordDoc.Application.ActiveDocument.Tables(1).Rows(j).Cells(i).Range.InsertAfter theArray(i,j)
objWordDoc.Application.ActiveDocument.Tables(1).Rows(j).Cells(i).Range.ParagraphFormat.alignment=1
Next
Next

End Sub
</SCRIPT>

[笨笨兔兔兔兔兔]

你的问题不在于代码，其实是这样的在开始-》运行输入-》dcomcnfg-》选dcom-》选word文档-》在属性里有交互的选项选上，在里面的安全把everyone权限加上

[笨笨兔兔兔兔兔]

另外vba的速度不大好

[hmz998]

我照 liuxiaoyi666(兔子)的做了，用OWC导出时还是超时,不用完成

[hqcsx]

EXCEL
<!--#include file="../conn/conn.asp"-->
<%
'导出xml,csv,htm文件DEMO
'用法：ExportDB.asp?t=文件类型&sql=sql语句
'文件类型可以是htm,csv,xml，默认是htm
'http://www.51windows.Net
'tablename = "htm"
Dim shijian,dingdan
shijian = now()
dingdan = year(shijian)&month(shijian)&day(shijian)&hour(shijian)&minute(shijian)&second(shijian)

dim tablename
sql2 = request("sql")
tablename = request("tablename")
if tablename = "" then
tablename = "数据导出结果"&dingdan
else
tablename = tablename&dingdan
end if
sql = replace(sql2,";","")

filetype = lcase(request("t"))
dim dbid,IndexPageName
function HTMLEncode(fString)
if not isnull(fString) then

fString = Server.HTMLEncode(fString)
fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
fString = Replace(fString, CHR(10), "<BR> ")
fString = Replace(fString, CHR(9), "  ")

HTMLEncode = fString
end if
end function

function Myreplace(str)
if not isnull(str) then
fString = Replace(fString,"""", """""")
Myreplace = str
else
Myreplace = ""
end if
end function

dim def_export_val
def_export_sep = ","
def_export_val = """"
if lcase(left(sql,6))<>"select" then
Response.write "出错了。。。"
Response.end
end if
Set rs = Conn.Execute(sql)
if filetype="xml" then
Response.contenttype="text/xml"
Response.Charset = "gb2312"
Response.AddHeader "Content-Disposition", "attachment;filename="&tablename&".xml"
Response.write "<?xml version=""1.0"" encoding=""gb2312""?>"
Response.write vbnewline&"<root>"
strLine=""
dim thefield(50)
i = 0
For each x in rs.fields
thefield(i)=x.name
i=i+1
Next
While rs.EOF =false
strLine= vbnewline&chr(9)&"<row>"
k=0
For each x in rs.fields
strLine= strLine & vbnewline&chr(9)&chr(9)&"<"&thefield(k)&">"
if instr(x.value,"<") or instr(x.value,">") or len(x.value)>255 then
strLine= strLine &"<![CDATA["& x.value &"]]>"
else
strLine= strLine & x.value
end if
strLine= strLine &"</"&thefield(k)&">"


k=k+1
Next
rs.MoveNext
Response.write strLine &vbnewline& chr(9)&"</row>"
Wend
Response.write vbnewline&"</root>"
elseif filetype="csv" then
'Response.contenttype="application/vnd.ms-excel"
Response.contenttype="text/csv"
Response.AddHeader "Content-Disposition", "attachment;filename="&tablename&".csv"



strLine=""
strLine="""会员帐号"",""高级会员"",""真实姓名"",""电子邮件"",""联系电话"",""联系传真"",""移动电话"",""邮政编码"",""联系地址"",""公司名称"",""密码提示问题"",""密码提示答案"",""登录次数"",""最后登录时间"",""注册时间"","

For each x in rs.fields
'strLine= strLine & def_export_val & def_export_val & def_export_sep
Next
Response.write strLine & vbnewline
While rs.EOF =false
strLine= ""
For each x in rs.fields
strLine= strLine & def_export_val & trim(Myreplace(x.value)) & def_export_val & def_export_sep
Next
rs.MoveNext
Response.write strLine & vbnewline
Wend
else
if filetype="htm" then'弹出下载html的对话框
Response.contenttype="application/ms-download"
Response.AddHeader "Content-Disposition", "attachment;filename="&tablename&".htm"
end if
%>
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<!--META NAME="Author" CONTENT="51windows,海娃,haiwa">
<META NAME="Description" CONTENT="Power by 51windows.Net"-->
<title>导出数据。。</title>
<style>
<!--
body { font-family: Verdana; font-size: 11px }
th { font-family: Verdana; font-size: 11px;padding:3px;color:#FFFFFF;background-color:#999999;}
td { font-family: Verdana; font-size: 11px;padding:3px;background-color:#EFEFEF;}
-->
</style>
</head>
<BODY style="overflow:auto;" topmargin=2 bgcolor=buttonface oncontextmenu=self.event.returnValue=false >
<div align="center">
<table border="0" cellpadding="0" cellspacing="1" bgcolor="#000000">
<tr>
<th align="center">会员帐号</th>
<th align="center">高级会员</th>
<th align="center">真实姓名</th>
<th align="center">电子邮件</th>
<th align="center">联系电话</th>
<th align="center">联系传真</th>
<th align="center">移动电话</th>
<th align="center">邮政编码</th>
<th align="center">联系地址</th>
<th align="center">公司名称</th>
<th align="center">密码提示问题</th>
<th align="center">密码提示答案</th>
<th align="center">登录次数</th>
<th align="center">最后登录时间</th>
<th align="center">注册时间</th>
</tr>
<%
i=0
For each x in rs.fields
strLine= strLine &chr(9)&chr(9)& vbnewline
Next
Response.write strLine&chr(9)& vbnewline & vbnewline
While rs.EOF =false
i=i+1
Response.write chr(9)&"<tr>"& vbnewline
strLine= ""
For each x in rs.fields
strLine= strLine &chr(9)&chr(9)&"<td>"& HTMLEncode(x.value) &"</td>"& vbnewline
Next
rs.MoveNext
Response.write strLine
Response.write chr(9)&"</tr>"& vbnewline & vbnewline
Wend
Response.write "</table>"& vbnewline
if filetype<>"htm" and filetype<>"xls" and filetype<>"txt" then
Response.write "<p style='line-height:160%;'>"&i&"条记录 <a href='?tablename="&request("tablename")&"&t=htm&sql="&server.urlencode(sql2)&"'>导出HTML</a>|<a href='?tablename="&request("tablename")&"&t=csv&sql="&server.urlencode(sql2)&"'>导出EXCEL</a>|<a href='?tablename="&request("tablename")&"&t=xml&sql="&server.urlencode(sql2)&"'>导出XML</a>"& vbnewline
end if
'Response.write "<p>Power by <A HREF=""http://www.51windows.Net"" target=""_blank"">51windows.Net</A>"& vbnewline
Response.write "</div>"& vbnewline
Response.write "</BODY>"& vbnewline
Response.write "</HTML>"& vbnewline
%>

<%
end if

rs.close
conn.close
Set rs=nothing
Set conn=nothing
%>


**********************************************************************************


<%
member_name = trim(request("member_name"))
member_sex = trim(request("member_sex"))
member_popedom = trim(request("member_popedom"))
sql2 = "select member_name,member_popedom,member_nickname,member_email,member_phone,member_fax,mobile_phone,member_postalcode,member_address,member_company,member_question,member_answer,member_count,now_date,now_first from member where member_id >= 1 "
if member_name <> "" then
sql_member_name = " and member_name like '%"&member_name&"%' "
sql2 = sql2 + sql_member_name
end if
if member_sex <> "" then
sql_member_sex = " and member_sex='"&member_sex&"' "
sql2 = sql2 + sql_member_sex
end if
if member_popedom <> "" then
sql_member_popedom = " and member_popedom = "&member_popedom&" "
sql2 = sql2 + sql_member_popedom
end if
sql2 = sql2 + " order by now_first desc "
%>

<input name="Submit" type="button" class="cabinput" value="导出网页" onClick="window.location.href='ExportDB.asp?t=htm&sql=<% = server.URLEncode(sql2) %>'" >
  
<input name="Submit" type="button" class="cabinput" value="导出表格" onClick="window.location.href='ExportDB.asp?t=csv&sql=<% = server.URLEncode(sql2) %>'">

[笨笨兔兔兔兔兔]

你说的是有可能的，我这么做的时候第一次就这样，还有我对权限可能说得不太清楚，如果出其他错误可以查google的，我第一做的时候查了好多东西的

还有不光是word文档，几种office文档你都这么做一次

[笨笨兔兔兔兔兔]

还有最小化法，从word.application 开始做起的

[underone]

UP