Asp生成EXCEL方法二(调试通过修改后可写入Excel标题自定义显示内容)

<%
'##################动态生成excel表格，并将内容一并写入######################
%>






生成EXCEL

---

<%

if Request("act") = "make" then
'else
'######################主程序开始###################

  dim sql,filepath,fs,myfile,x,link
 
  Set fs = server.CreateObject("scripting.filesystemobject")
  '--假设你想让生成的EXCEL文件做如下的存放
  temp=Server.MapPath("index.asp") '获取index.asp主页所在路径。
  path=Left(temp,len(temp)-9)      '获取路径字符串。
  filename = "books.xls"           '指定Excel文件名。
  filepath = path&filename         '生成Excel文件名及路径。
  '--如果原来的EXCEL文件存在的话删除它
  if fs.FileExists(filepath) then
    fs.DeleteFile(filepath)        '删除已经存在的同名文件。
  end if
  '--创建EXCEL文件
  set myfile = fs.CreateTextFile(filepath,true)
  Set rs = Server.CreateObject("ADODB.Recordset")
  '--从数据库中把你想放到EXCEL中的数据查出来
  sql="select * from book order by id"
  rs.Open sql,conn,1,3
 
  recnum=rs.recordcount                     '获取记录数。
 
  if rs.EOF and rs.BOF then
  else
'######################开始写入###################
    dim strLine,responsestr
    strLine=""
    fieldnum=0
 myfile.writeline chr(9)&chr(9)&"Excel标题"'此处可定义Excel标题
      For each x in rs.fields
        strLine= strLine & x.name & chr(9)  'chr(9)是指的水平方向上的制表符。
        fieldnum=fieldnum+1                 '获取字段数。
      Next
   
      '--将表的列名先写入EXCEL
      myfile.writeline strLine

      Do while Not rs.EOF
      strLine=""
          w=0'定义一个变量，判断变量可以进行自定义操作
      for each x in rs.Fields
   if w=0 then
   strLine= strLine&"自定义文字"& chr(9)
   else
        strLine= strLine & x.value & chr(9)
   end if
   w=w+1
      next
      '--将表的数据写入EXCEL
      myfile.writeline strLine

      rs.MoveNext
      loop
     
  end if

rs.Close
set rs = nothing
conn.close
set conn = nothing
set myfile = nothing
Set fs=Nothing

'读取写入信息此操作本地成功远程提示没有'CreateObject'权限
set objExcelApp = CreateObject("Excel.Application")
objExcelApp.DisplayAlerts = false        '不显示警告
objExcelApp.Application.Visible = false  '不显示界面

objExcelApp.WorkBooks.Open(filepath)
set objExcelBook = objExcelApp.ActiveWorkBook
set objExcelSheets = objExcelBook.Worksheets
set objExcelSheet = objExcelBook.Sheets(1)
response.write "

"
for i=1 to recnum+1
  response.write ""
  for j=1 to fieldnum
    If i=1 Then
      response.write ""
    Else
      response.write ""
    End If
  next
  response.write ""
next
response.write "

"&objExcelSheet.Cells(i,j).value&chr(9)&"

"&objExcelSheet.Cells(i,j).value&chr(9)&"

"
objExcelApp.Quit                    ' 一定要退出
set objExcelApp = Nothing

link="恭喜您报表生成成功!打开Excel文件：" & filename &"  关  闭"
Response.write link
end if
%>