ASP操作EXCEL

<!-- #include file="conn.asp" -->
<%
Response.CacheControl ="no-cache"

XlsTabName=trim(Request("XlsTabName"))
strSql=trim(Request("strSql"))
''XlsTabName="RFQ"
''strSql="select * from("
''strSql=strSql&"select distinct R.Rnumber,R.RuserID,U.NtName,U.UserName,R.DeptCode,R.ProjCode,R.JPCProdNo,R.ProdName,R.CustCode,R.RwriteDate,R.Estimeate,R.Actual,R.EngineerID,U2.NtName as EngNtName,U2.UserName as EngUserName,C.CodeDesc,R.EProgress,R.REF_NO,R.Rstatus from RFQS_App R,Signed S,Users U,Users U2,Codes C where right(left(R.Rnumber,4),3)='RFQ' and R.RuserID=U.UID and R.EngineerID=U2.UID and C.Class='Fac' and U2.UID=R.EngineerID and U2.FacCode=C.CodeNo and S.ScheckID='15' and R.Rnumber=S.RFnumber "
''strSql=strSql&" union all select distinct R.Rnumber,R.RuserID,U.NtName,U.UserName,R.DeptCode,R.ProjCode,R.JPCProdNo,R.ProdName,R.CustCode,R.RwriteDate,R.Estimeate,R.Actual,R.EngineerID,R.EngineerID as EngNtName,R.EngineerID as EngUserName,R.EngineerID as FacDesc,R.EProgress,R.REF_NO,R.Rstatus from RFQS_App R,Signed S,Users U where right(left(R.Rnumber,4),3)='RFQ' and R.RuserID=U.UID and (R.EngineerID='' or R.EngineerID is null) and S.ScheckID='15' and R.Rnumber=S.RFnumber"
''strSql=strSql&") tab1 Order by RwriteDate DESC "
''Response.Write(strSql)
''Response.End()
                   randomize
       strrnd=right("00"&int(rnd()*100),2)
                   yy=year(date)
                   mm=right("00"&month(date),2)
                   dd=right("00"&day(date),2)
                   hh=right("00"&hour(time),2)
                   mins=right("00"&minute(time),2)
                   ss=right("00"&second(time),2)
       tfile1="XLS/"&XlsTabName&"_"&yy&mm&dd&hh&mins&ss&"_"&strrnd&"_"&session("uid")&".xls"
Set fs = Server.CreateObject("Scripting.FileSystemObject")
SFile = Server.MapPath("RFQS_Templates.xls")
TFile = Server.MapPath(tfile1)
fs.CopyFile SFile, TFile
set fs=nothing

On Error Resume Next
if Instr(XlsTabName,"RF")>0 then 
  select case XlsTabName
  case "RFQ"
     iSheet=1
  i_c=19
  case "RFS"
     iSheet=2
  i_c=20
  case "RFD"
     iSheet=3
  i_c=18
  case "NRFQ"
     iSheet=4
  i_c=17
  case "RFQSQuery"
     iSheet=5
  i_c=19
  case "RFDQuery"
     iSheet=6
  i_c=18
  case "NRFQQuery"
     iSheet=7
  i_c=17
  case "RFQSHistory"
     iSheet=8
  i_c=9
  case "RFDHistory"
     iSheet=9
  i_c=9
  case "NRFQHistory"
     iSheet=10
  i_c=9
  end select
 
  set objExcelApp=CreateObject("Excel.Application")
  objExcelApp.DisplayAlerts=false
  objExcelApp.Application.Visible=false
  ''response.write "Create OK"
  ''open excel
  strAddr=Server.MapPath(tfile1)
  objExcelApp.WorkBooks.Open(strAddr)
  set objExcelBook=objExcelApp.ActiveWorkBook
  set objExcelSheets=objExcelBook.Worksheets
  set objExcelSheet=objExcelBook.Sheets(iSheet)
  ''read excel
  ''str1=trim(objExcelSheet.Cells(1,1).value)

  ''write excel
  set rsOut=ConnDB.execute(strSql)
  i_r=2
  do while not rsOut.eof
     for i_i=1 to i_c
         objExcelSheet.Cells(i_r,i_i)="'"&rsOut(i_i-1)
  next
  i_r=i_r+1
  rsOut.movenext()
  loop
  rsOut.close()
  set rsOut=nothing
 
  objExcelApp.Save()
  call closeexcel()

  Sub closeexcel()
  ''close excel app
  objExcelApp.WorkBooks.close()
  set objExcelSheet=Nothing
  set objExcelSheets=Nothing
  set objExcelBook=Nothing
  objExcelApp.Quit
  set objExcelApp=Nothing
  end Sub
else
  strOut="insert into OpenRowSet('microsoft.jet.oledb.4.0','Excel 8.0;hdr=yes;database="&Server.MapPath(tfile1)&";','select * from ["&XlsTabName&"$]')"
  strOut=strOut&strSql
  set rsOut=Server.CreateObject("adodb.recordset")
  rsOut.Open strOut,ConnDB
  set rsOut=nothing
  end if
if err.number<>0 then
  Response.Write("<font color='#ff0000'>&nbsp;<b>[Err]</b>&nbsp;"&server.HTMLEncode(err.description)&"</font>")
  err.Clear
  Set fs = Server.CreateObject("Scripting.FileSystemObject")
  fs.DeleteFile TFile, True
  set fs=nothing
else
  Response.Write("<font color='#ff0000'>&nbsp;OK&nbsp;</font><a href='../OutExcel/"&tfile1&"' target='_blank'>"&tfile1&"</a>")
end if
%>


<%call CloseDB()%>

發表評論
所有評論
還沒有人評論,想成為第一個評論的人麼? 請在上方評論欄輸入並且點擊發布.
相關文章