继续ASP2EXCEL

注意：本文最后更新于 2777 天前，有关的内容可能已经发生变化，请参考使用。

帮学校做个系统 ASP的今天晚上解决一系列问题之后遇到一个比较纠结的问题asp控制Excel的Xls属性问题

尝试了一下用下面的两种方法

第一种通用性更强适合大多数主机

第二种用起来比较方便对Excel操作更好但是对主机的环境要求颇为苛刻

明眼人一看就知道第一种其实就是通过asp的一个组件直接写数据把查询到的数据直接写到文件里这么一来让EXCEL自己去识别成XLS 虽然有些牵强但是效果还是很好的所以以前做东西我更喜欢第一种方法但是问题在于这次做的系统的数据库有很多的学号考号之类的都是很长一段的数字这种情况下用第一种方法的结果是长数字被EXCEL直接当作数字类型用科学计数法表示
实在是很Onz。。。。。又因为这种生成xls文件的特殊性所以基本没有什么办法来解决这个问题


    dim path
    path=server.MapPath("report.xls")
    set fso=server.CreateObject("Scripting.filesystemobject")
    if fso.FileExists(path) then
    fso.deletefile(path)  
    end if  
    
    set myfile=fso.createtextfile(path,true)
    set rs=server.CreateObject("adodb.recordset")
    
    rs.open str,conn,3,4
    
    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
    set myfile = nothing
    Set fs=Nothing


    rs.open str,conn,3,4  '这里用sql语句查询需要导出的内容
      
      'On error resume next
    if rs.eof then
       Response.write "没有记录可导出！ "
       rs.close
       set rs=nothing
       response.End()
    end if
    
    Dim App,Book,Shts,Sht
    set App = CreateObject("Excel.Application")
    App.Visible   =   False   '无需打开excel 
    App.DisplayAlerts =true '不显示警告
    App.Application.Visible = false '不显示界面
    
    '添加Excel表
    App.WorkBooks.add
    set Book = App.ActiveWorkBook
    set Shts = Book.Worksheets
    set Sht = Book.Sheets(1)
    kk=0
    for j=1 to recordcounts
      if request.Form("checkbox"&j)<>"" then
         Sht.Range(chr(asc("A")+int(kk))&"1:"&chr(asc("A")+int(kk))&"1").Value =request.Form("checkbox"&j)
         Sht.Columns("A:A").NumberFormatLocal = "0_ "
       kk=kk+1
      end if
    next
    Dim r '行数
    r=2   '从第二行开始写
    Dim DeferOctEmp,IsCheck
    do while not rs.eof
    kk=0
    for j=1 to recordcounts
        kindname=request.Form("checkbox"&j)
       if request.Form("checkbox"&i)="考生号" then kindname="ksh"
       if request.Form("checkbox"&i)="录取号" then kindname="lqh"
       if request.Form("checkbox"&i)="专业" then kindname="录取大专业"
       if request.Form("checkbox"&i)="接收单位隶属部门" then kindname="单位隶"
       if request.Form("checkbox"&i)="协议书编号" then kindname="xysh"
       
      if kindname<>"" then
         if not isnull(rs(""&kindname&"")) or trim(rs(""&kindname&""))<>"" then Sht.Range(chr(asc("A")+int(kk))&r&":"&chr(asc("A")+int(kk))&r).Value=rs(""&kindname&"")
         kk=kk+1
       end if
    next
    rs.movenext
    r=r+1
    loop
    rs.close
    set rs=nothing
    '设置自动列宽
    'Sht.Range("A1:"&chr(asc("A")+int(recordcounts-1))&(r-1)).Columns.AutoFit
    
    '保存Excel文件
    Dim ExcelFile
    ExcelFile="Excel/ecjtu"&session("user")&".xls"
    Set fso = Server.CreateObject("Scripting.FileSystemObject") 
    if fso.fileexists(Server.MapPath(ExcelFile)) then   fso.deleteFile(Server.MapPath(ExcelFile))
    set fso=nothing
    Book.SaveAs Server.MapPath(ExcelFile)
    
    if err.Number<>0 then
       Response.write err.Description 
       App.Quit
       set App = Nothing
       response.end
    end if
    Book.Save
    App.Quit
    set App = Nothing
    Response.Redirect ExcelFile

「倘若有所帮助，不妨酌情赞赏!」

相关文章