toexcel.txt

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

                                                           .LineStyle  =  1  
                                                           .Weight  =  -4138  
                                                           .ColorIndex  =  -4105  
                                   End  with  
                                   with  .Range(.Cells(1,1),  .Cells(rowcount  +  1,  colcount  +  1)).Borders(11)  '画下边界  
                                                           .LineStyle  =  1  
                                                           .Weight  =  2  
                                                           .ColorIndex  =  -4105  
                                   End  with  
                                   with  .Range(.Cells(1,1),  .Cells(rowcount  +  1,  colcount  +  1)).Borders(12)  '画下边界  
                                                           .LineStyle  =  1  
                                                           .Weight  =  2  
                                                           .ColorIndex  =  -4105  
                                   End  with  
                       End  with  
                       rowcount  =  0  
                       colcount  =  0  
           End  if  
end  sub  
 
sub  PowerList(flag,  obj)  
           Dim  x,  y,  c,  a,  str_key,  str_sql,  l_start,  location,  b,  b_start,  str_bkey  
 
           If  flag=  true  then  
                       x  =  rowcount  
                       y  =  colcount  
           Else  
                       x  =  colcount  
                       y  =  rowcount  
           End  if  
           l_start=1  
             
           for  a  =  1  to  y  
                       location=dhCountTime(Userskey,";",  a)  
                       str_key=Mid(Userskey,  l_start,  location  -  l_start)  
                       l_start=location  +  1  
                         
                       str_sql="select  user_sincluder  from  ksweb_usertable  where  user_ssyskey='<%=sAppkey%>'  and  user_skey='"  &  str_key  &  "'"  
                       FunRunADC(str_sql)  
                         
                       If  ADC.Recordset.RecordCount  >  0  then  
                                   If  len(Trim(ADC.Recordset("user_sincluder")))  >  0  then  
                                               b_start=1  
                                               for  b  =  1  to  x  
                                                           location=dhCountTime(UserGroupkey,";",  b)  
                                                           str_bkey=Mid(UserGroupkey,  b_start,  location  -  b_start)  
                                                           b_start=location  +  1  
                                                           If  instr(1,  Trim(ADC.Recordset("user_sincluder")),  str_bkey)  >  0  then  
                                                                       If  flag=true  then  
                                                                                   obj.ActiveWorkBook.Activesheet.Cells(b+1,  a+1)="√"              
                                                                       Else  
                                                                                   obj.ActiveWorkBook.Activesheet.Cells(a+1,  b+1)="√"              
                                                                       end  if  
                                                           end  if  
                                               next  
                                   End  if  
                       End  if  
           next  
End  sub

确保文件名唯一  
strFileName  =  Session.SessionID  &  ".xls"  
strAppPath  =  Request.ServerVariables("PATH_TRANSLATED")  
strAppPath  =  Left(strAppPath,  InstrRev(strAppPath,  "\"))  
strFullPath  =  strAppPath  &  strFileName  
'保存文件  
myWorkbook.SaveAs(strFullPath)  
'关闭Excel  
myWorkbook.Close  
xlApp.Quit  
set  myWorksheet  =  Nothing  
set  myWorkbook  =  Nothing  
set  myxlApp  =  Nothing  
'写出到浏览器中  
Response.Redirect  strFileName  
 
---------------------------------------------------------------  
 
<%@  LANGUAGE="VBSCRIPT"  %>  
<%option  explicit%>  
<HTML>  
<HEAD>  
<meta  content="text/html;  charset=gb2312"  http-equiv="Content-Type">  
<TITLE>生成EXCEL文件</TITLE>  
</HEAD>  
<body>  
<a  href="dbtoexcel.asp?act=make">生成在线人口的EXCEL</a>  
<hr  size=1  align=left  width=300px>  
<%  
if  Request("act")  =  ""  then  
     Response.Write  "生成EXCEL文件"  
else  
 
dim  conn,strconn  
strconn="driver={SQL  Server};server=wen;uid=sa;pwd=;database=DB_Test"  
set  conn=server.CreateObject("adodb.connection")  
conn.Open  strconn  
 
dim  rs,sql,filename,fs,myfile,x  
 
Set  fs  =  server.CreateObject("scripting.filesystemobject")  
'--假设你想让生成的EXCEL文件做如下的存放  
filename  =  Server.MapPath("online.xls")  
'--如果原来的EXCEL文件存在的话删除它  
if  fs.FileExists(filename)  then  
fs.DeleteFile(filename)  
end  if  
'--创建EXCEL文件  
set  myfile  =  fs.CreateTextFile(filename,true)  
 
Set  rs  =  Server.CreateObject("ADODB.Recordset")  
'--从数据库中把你想放到EXCEL中的数据查出来  
sql  =  "select  *  from  Tb_Execl  order  by  sort  desc"  
rs.Open  sql,conn  
if  rs.EOF  and  rs.BOF  then  
     Response.Write  "库里暂时没有数据！"  
else  
dim  strLine,responsestr  
strLine=""  
For  each  x  in  rs.fields  
strLine=  strLine  &  x.name  &  chr(9)  
Next  
 
'--将表的列名先写入EXCEL  
myfile.writeline  strLine  
 
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  
end  if  
rs.Close  
set  rs  =  nothing  
conn.close  
set  conn  =  nothing  
set  myfile  =  nothing  
Set  fs=Nothing  
end  if  
%>