继续ASP2EXCEL

帮学校做个系统 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


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

Holmesian

感谢您的支持!

使用微信扫描二维码完成支付


相关文章

发表新评论