如何将查询出来的记录集(已经显示在table中)导出到excel中(急!在线等)

yeskele 2004-08-10 02:34:57

rt~~~~~~~~~~~~~~~~~~~~~~~~~~~

...全文

306 11 打赏收藏举报

写回复

11 条回复

切换为时间正序

当前发帖距今超过3年，不再开放新的回复

发表回复

kenvinp 2004-08-25

good. study

打赏
举报

回复赞

hrstudy 2004-08-10

<%
If OfficeA="mword" Then Response.ContentType = "application/msword" '转换为WORD文档
If OfficeA="mexcel" Then Response.ContentType = "application/vnd.ms-excel" '转换为EXCEX文档
%>
在文件头中加入上面的代码，然后在文档适当的地方加入两个按钮
<input type="button" value="转成Excel文档" onclick="location.href='FileName.asp?OfficeA=mexcel'">
<input type="button" value="转成Word文档" onclick="location.href='FileName.asp?OfficeA=mword'">

打赏
举报

回复赞

ahcsdn 2004-08-10

给你一个能“ 生成Excel的” 源代码具体怎样操作你自己办了

'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
end if

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 btel as 号码 FROM bmember", "Provider=SQLOLEDB.1;Persist Security Info=True;User ID=sa;Password=;Initial Catalog=7056a;Data source=127.0.0.1;"
Dim SaveName
SaveName = Request.Cookies("savename")("name")
Dim objExcel
Dim ExcelPath
ExcelPath = "Excel\gg.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