导出Excel小结

'**说明：在ASP.net里实现导出Excel(follows help me resolve my task,it is very good,I like it)

Public Class cmpDataGridToExcel
  Inherits System.ComponentModel.Component

Public Shared Sub DataGridToExcel(ByVal dgExport As DataGrid, ByVal response As HttpResponse)
  'clean up the response.object(I didn't use below 2 lines for can't get data)
  response.Clear()
  response.Charset = ""
  'set the response mime type for excel
  response.ContentType = "application/vnd.ms-excel"
  'create a string writer
  Dim stringWrite As New System.IO.StringWriter()
  'create an htmltextwriter which uses the stringwriter
  Dim htmlWrite As New System.Web.UI.HtmlTextWriter(stringWrite)

  'instantiate a datagrid
  Dim dg As New DataGrid()
  ' just set the input datagrid = to the new dg grid
  dg = dgExport

  ' I want to make sure there are no annoying gridlines
  dg.GridLines = GridLines.None
  ' Make the header text bold
  dg.HeaderStyle.Font.Bold = True

  ' If needed, here's how to change colors/formatting at the component level
  'dg.HeaderStyle.ForeColor = System.Drawing.Color.Black
  'dg.ItemStyle.ForeColor = System.Drawing.Color.Black

  'bind the modified datagrid
  dg.DataBind()
  'tell the datagrid to render itself to our htmltextwriter
  dg.RenderControl(htmlWrite)
  'output the html
  response.Write(stringWrite.ToString)
  response.End()
End Sub

End Class

-----------------------------------------------------------------

**说明：下面的ASP代码实现直接存成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 = ""
   Response.Write "4" & "<br>"
 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
 Dim strConn
 Dim conn
 Dim sql
 Set conn = Server.CreateObject("ADODB.Connection")
 strConn = "Provider = SQLOLEDB ;Data Source =localhost; Initial Catalog=pubs; User ID=sa; Password=sa"

 conn.Open strConn
 set objRS = server.CreateObject("adodb.recordset")
 sql="select * from authors"
 objRS.open sql,strConn

Dim SaveName
 '这里因为没有Cookies，所以把 SaveName 写死了！自己要改啊！
 'SaveName = Request.Cookies("savename")("name")
 
         SaveName=request.form("excelname")

Dim objExcel
Dim ExcelPath
 ExcelPath = "Excel/" & SaveName & ".xls"    '这里把保存路径设在了名为“Excel”的文件夹里（“Excel”文件夹必须存在）
 Set objExcel = New ExcelGen
 objExcel.RowOffset = 1
 objExcel.ColumnOffset = 1
 objExcel.GenerateWorksheet(objRS)
   
If objExcel.SaveWorksheet(Server.MapPath(ExcelPath)) then
 
 Response.Write "<script language='javascript'>alert(""已保存为Excel文件"");</script>"
Else
 Response.Write "<script language='javascript'>alert(""在保存过程中有错误!"");</script>"
End If
    Response.Write "<p><input type=button value=""关闭"" name=""closeBT"" onclick=""javascript:window.close();"">"
Set objExcel = Nothing
 objRS.Close
Set objRS = Nothing

%>

------------------------------------------------------------

'下面的代码实现在ASP页面下载Excel文件到本地（It's good, I like it）
但是注意：一定要在客户机上连接服务器试，在本机会出错

<%

'这里需要修改你自己的SQLSERVER的用户名和密码,还有相应的服务器名称！
'连接数据库
 Dim objRS
 Dim strConn
 Dim conn
 Dim sql
 Set conn = Server.CreateObject("ADODB.Connection")
 strConn = "Provider = SQLOLEDB ;Data Source =Test-server; Initial Catalog=pubs; User ID=sa; Password=sa"

 conn.Open strConn
 set objRS = server.CreateObject("adodb.recordset")
 sql="select * from authors"
 objRS.open sql,strConn

'以表的方式显示查询结果，先显示字段名称
response.Write "<table border=3>"
response.Write "<tr>"

'show field name first
for I=0 to objRS.Fields.count-1
   response.Write "<td>" & ucase(objRS(I).Name) & "</td>"
next
response.Write "</tr>"

'显示字段数据

while not objRS.EOF
    response.Write "<tr>"
     
    for I=0 to objRS.Fields.count-1
         response.Write "<td>" & objRS(I).Value & "</td>"
    next
    objRS.MoveNext
    response.Write "</tr>"
wend

response.Write "</table>"

'response.ContentType ="application/vnd.ms-excel"

' download file

Dim Stream
Dim Contents
Dim FileName
Dim FileExt
Const adTypeBinary = 1

FileName=request.form("excelname")
'FileName="请自定文件名"
response.Write FileName

response.ContentType ="application/vnd.ms-excel"

Response.AddHeader "content-disposition", "attachment; filename=" & FileName

'--------------下面的代码不知道为什么会没用了，删除就没问题了（原来不会有问题的啊）---------

'Set Stream = server.CreateObject("ADODB.Stream")

'Stream.Type = adTypeBinary
'Stream.Open
'Stream.LoadFromFile Server.MapPath(FileName)
'While Not Stream.EOS
'    'Response.BinaryWrite Stream.Read(1024 * 64)
'    Response.BinaryWrite Stream.Read
'Wend
'Stream.Close
'Set Stream = Nothing
'Response.Flush
'Response.End
'----------------------------------------------------------------------------

set objRS=nothing

%>