asp导入EXEL文档

来源：互联网发布：JS中nan==nan 编辑：程序博客网时间：2024/05/26 08:42

<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%><!--#include file="upload_5xsoft.inc"--> <html xmlns="http://www.w3.org/1999/xhtml"><head><meta http-equiv="Content-Type" content="text/html; charset=gb2312" /><title>EXECL数据导入</title><style type="text/css"><!--body,td,th { font-size: 12px; color: #666666;}--></style></head><body><%session.CodePage=936Server.ScriptTimeOut=600000set upload=new upload_5xsoftset file=upload.file("file1")if file.fileSize>120000 then%><script>alert("您选择的文件过大!");</script><% end if if file.fileSize>0 then    filename=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)    filename=filename+"."    filenameend=file.filename    filenameend=split(filenameend,".")if filenameend(1)="xls" then        filename=filename&filenameend(1)        file.saveAs Server.mappath("/admin/user/uploadFile/"&filename)else   response.write "数据格式不对！"  response.end()    end if    set file=nothingelse        response.write "文件不能为空！"  response.end()End ifset upload=nothing'上传XLS文件结束，下面从上传的XLS文件中读取数据写入到SQL数据库   strAddr=server.MapPath("/admin/user/uploadFile/"&filename)   set excelconn=server.createobject("adodb.connection")    excelconn.open "Provider = Microsoft.Jet.OLEDB.4.0 ; Data Source = "+strAddr+";Extended Properties='Excel 8.0;HDR=NO;IMEX=1'"    set conn=server.createobject("adodb.connection")   conn.open "Provider=SQLOLEDB.1;Persist Security Info=True;User ID='.';Password='.'; Initial Catalog ='.'; Data Source='.';" set rs=server.CreateObject("adodb.recordset") set rs1=server.CreateObject("ADODB.Recordset") sql="select distinct  * from [insertUserList$]"  rs.open sql,excelconn,1,1  if not(rs.bof and rs.eof) then  rs.movenext  do while not rs.eof  set nRecordSet=conn.execute("select Email from [Usera] where Email='"& rs(0) &"'")    If  nRecordSet.Recordcount>0 Then   rs.movenext   Else    If isnull(rs(1)) Then   Dim name   name=Split(rs(0),"@")    sql1="select * from [Usera] where UserID is null"    rs1.open sql1,conn,1,3    rs1.addnew       rs1("Email")=rs(0)       rs1("UserName")=name(0)       rs1("Typea")=rs(2)       rs1("password")="123456"       rs1("sitefor")="CTA"       rs1("Sex")=rs(3)       rs1("Phone")=rs(4)       rs1("Nationality")=rs(5)   rs1.update   rs1.close   rs.movenext   else   sql1="select * from [Usera] where UserID is null"    rs1.open sql1,conn,1,3    rs1.addnew       rs1("Email")=rs(0)       rs1("UserName")=rs(1)       rs1("Typea")=rs(2)       rs1("password")="123456"       rs1("sitefor")="CTA"       rs1("Sex")=rs(3)       rs1("Phone")=rs(4)       rs1("Nationality")=rs(5)   rs1.update   rs1.close   rs.movenext   End if End if  loop end if rs.close()   set rs=nothing  set rs1=nothing excelconn.Close()    set excelconn=nothing conn.close()  set conn=nothing%> <script>   alert("数据导入成功！");   history.back(); </script></body></html>

PS：必须引用的一个类命名upload_5xsoft.inc.bak

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>dim Data_5xsoftClass upload_5xsoftdim objForm,objFile,VersionPublic function Form(strForm)   strForm=lcase(strForm)   if not objForm.exists(strForm) then     Form=""   else     Form=objForm(strForm)   end if end functionPublic function File(strFile)   strFile=lcase(strFile)   if not objFile.exists(strFile) then     set File=new FileInfo   else     set File=objFile(strFile)   end if end functionPrivate Sub Class_Initialize   dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile  dim iFileSize,sFilePath,sFileType,sFormvalue,sFileName  dim iFindStart,iFindEnd  dim iFormStart,iFormEnd,sFormName  'Version="化境HTTP上传程序 Version 2.0"  set objForm=Server.CreateObject("Scripting.Dictionary")  set objFile=Server.CreateObject("Scripting.Dictionary")  if Request.TotalBytes<1 then Exit Sub  set tStream = Server.CreateObject("adodb.stream")  set Data_5xsoft = Server.CreateObject("adodb.stream")  Data_5xsoft.Type = 1  Data_5xsoft.Mode =3  Data_5xsoft.Open  Data_5xsoft.Write  Request.BinaryRead(Request.TotalBytes)  Data_5xsoft.Position=0  RequestData =Data_5xsoft.Read   iFormStart = 1  iFormEnd = LenB(RequestData)  vbCrlf = chrB(13) & chrB(10)  sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1)  iStart = LenB (sStart)  iFormStart=iFormStart+iStart+1  while (iFormStart + 10) < iFormEnd  iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3 tStream.Type = 1 tStream.Mode =3 tStream.Open Data_5xsoft.Position = iFormStart Data_5xsoft.CopyTo tStream,iInfoEnd-iFormStart tStream.Position = 0 tStream.Type = 2 tStream.Charset ="gb2312" sInfo = tStream.ReadText tStream.Close '取得表单项目名称 iFormStart = InStrB(iInfoEnd,RequestData,sStart) iFindStart = InStr(22,sInfo,"name=""",1)+6 iFindEnd = InStr(iFindStart,sInfo,"""",1) sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart)) '如果是文件 if InStr (45,sInfo,"filename=""",1) > 0 then  set theFile=new FileInfo  '取得文件名  iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10  iFindEnd = InStr(iFindStart,sInfo,"""",1)  sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)  theFile.FileName=getFileName(sFileName)  theFile.FilePath=getFilePath(sFileName)  '取得文件类型  iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14  iFindEnd = InStr(iFindStart,sInfo,vbCr)  theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)  theFile.FileStart =iInfoEnd  theFile.FileSize = iFormStart -iInfoEnd -3  theFile.FormName=sFormName  if not objFile.Exists(sFormName) then    objFile.add sFormName,theFile  end if else '如果是表单项目  tStream.Type =1  tStream.Mode =3  tStream.Open  Data_5xsoft.Position = iInfoEnd   Data_5xsoft.CopyTo tStream,iFormStart-iInfoEnd-3  tStream.Position = 0  tStream.Type = 2  tStream.Charset ="gb2312"         sFormvalue = tStream.ReadText          tStream.Close  if objForm.Exists(sFormName) then    objForm(sFormName)=objForm(sFormName)&", "&sFormvalue      else    objForm.Add sFormName,sFormvalue  end if end if iFormStart=iFormStart+iStart+1 wend  RequestData=""  set tStream =nothingEnd SubPrivate Sub Class_Terminate   if Request.TotalBytes>0 then objForm.RemoveAll objFile.RemoveAll set objForm=nothing set objFile=nothing Data_5xsoft.Close set Data_5xsoft =nothing end ifEnd SubPrivate function GetFilePath(FullPath)  If FullPath <> "" Then   GetFilePath = left(FullPath,InStrRev(FullPath, "\"))  Else   GetFilePath = ""  End If End  function Private function GetFileName(FullPath)  If FullPath <> "" Then   GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)  Else   GetFileName = ""  End If End  functionEnd ClassClass FileInfo  dim FormName,FileName,FilePath,FileSize,FileType,FileStart  Private Sub Class_Initialize     FileName = ""    FilePath = ""    FileSize = 0    FileStart= 0    FormName = ""    FileType = ""  End Sub Public function SaveAs(FullPath)    dim dr,ErrorChar,i    SaveAs=true    if trim(fullpath)="" or FileStart=0 or FileName="" or right(fullpath,1)="/" then exit function    set dr=CreateObject("Adodb.Stream")    dr.Mode=3    dr.Type=1    dr.Open    Data_5xsoft.position=FileStart    Data_5xsoft.copyto dr,FileSize    dr.SaveToFile FullPath,2    dr.Close    set dr=nothing     SaveAs=false  end function  End Class</SCRIPT>

阅读全文

0 0