reporttoexcel.asp

财务管理系统 报账等基本功能实现 有完整的实现

<!--#include file="../../adovbs.inc"-->
<%
Public Sub ReportToExcel(TmpMonth)
  '提取数据库中工资统计表的此月份记录
  Dim cmd,rs
  Set cmd= Server.CreateObject("ADODB.Command")
  Set rs = Server.CreateObject("ADODB.RECORDSET")
  '设置cmd的ActiveConnection属性，指定与其关联的数据库连接
  cmd.ActiveConnection = Conn
  cmd.CommandText = "CreateSalaryReport"
  cmd.CommandType = adCmdStoredProc
  '创建存储过程参数
  cmd.Parameters("@@iM") = TmpMonth
  cmd.Execute    '执行存储过程
  SqlStmt = "SELECT * FROM TmpTable ORDER BY 员工编号"
  rs.Open SqlStmt,Conn,1,3
  Irowcount = 0
  Do While Not rs.EOF 
    '记录总数   
    Irowcount = Irowcount + 1
    rs.MoveNext()
  Loop
  '如果记录为空，则退出程序
  If Irowcount<1 Then
    Response.Write "数据库中没有记录"
    Response.End()
  End If
  '字段总数
  Icolcount = rs.Fields.Count
  '确保文件名唯一  
  strFileName  =  TmpMonth  &  ".xls"  
  strAppPath  =  Request.ServerVariables("PATH_TRANSLATED")  
  strAppPath  =  Left(strAppPath,  InstrRev(strAppPath,  "\"))  
  strFullPath  =  strAppPath  &  strFileName  
  '创建文件脚本对象
  Set  fs  =  server.CreateObject("scripting.filesystemobject")  
  '--假设你想让生成的EXCEL文件做如下的存放  
  filename  =  Server.MapPath(strFileName)  
  '--如果原来的EXCEL文件存在的话删除它  
  If  fs.FileExists(filename)  Then  
    fs.DeleteFile(filename)  
  End If  
  '--创建EXCEL文件  
  Set  myfile  =  fs.CreateTextFile(filename,true)  
  Dim  strLine,responsestr  
  strLine=""  
  For  Each  x In  rs.fields  
    strLine=  strLine  &  x.name  &  chr(9)  
  Next   
  '--将表的列名先写入EXCEL  
  myfile.writeline  strLine  
  rs.MoveFirst()
  Do  While  Not  rs.EOF  
    strLine=""   
    For Each  x In  rs.Fields  
      strLine=  strLine  &  x.value  &  chr(9)  
    Next 
    '--将表的数据写入EXCEL  
    myfile.writeline  strLine  
    rs.MoveNext  
  Loop
  rs.Close()
End Sub
%>