ASP将Excel数据导入到SQLServer的实现代码


            复制代码 代码如下: <form action="insert.asp" method="post" enctype="multipart/form-data" name="form1" onSubmit="b1_onclick()"> <table width="500" border="1" align="center" cellpadding="0" cellspacing="0"> <tr> <td colspan="2" bgcolor="#999999" class="t">选择文件 </td> </tr> <tr> <td colspan="2" class="t"> </td> </tr> <tr> <td width="126" class="t">选择文件(excel) </td> <td width="368" class="t"><label> <input name="filexls" type="file" size="35"> </label></td> </tr> <tr> <td colspan="2" class="t"> <label> <input type="submit" name="Submit" value="导入数据"> </label> <a href="1122.asp" class="t">返回</a> </td> </tr> </table> </form> <!--#include virtual="/inc/clsdbctrl.asp"--> <!--#include virtual="/inc/function.asp"--> <% dim upfile_5xSoft_Stream Class upload_5xSoft dim Form,File,Version Private Sub Class_Initialize dim iStart,iFileNameStart,iFileNameEnd,iEnd,vbEnter,iFormStart,iFormEnd,theFile dim strDiv,mFormName,mFormValue,mFileName,mFileSize,mFilePath,iDivLen,mStr Version="任翔专用上传程序" if Request.TotalBytes<1 then Exit Sub set Form=CreateObject("Scripting.Dictionary") set File=CreateObject("Scripting.Dictionary") set upfile_5xSoft_Stream=CreateObject("Adodb.Stream") upfile_5xSoft_Stream.mode=3 upfile_5xSoft_Stream.type=1 upfile_5xSoft_Stream.open upfile_5xSoft_Stream.write Request.BinaryRead(Request.TotalBytes) vbEnter=Chr(13)&Chr(10) iDivLen=inString(1,vbEnter)+1 strDiv=subString(1,iDivLen) iFormStart=iDivLen iFormEnd=inString(iformStart,strDiv)-1 while iFormStart < iFormEnd iStart=inString(iFormStart,"name=""") iEnd=inString(iStart+6,"""") mFormName=subString(iStart+6,iEnd-iStart-6) iFileNameStart=inString(iEnd+1,"filename=""") if iFileNameStart>0 and iFileNameStart<iFormEnd then iFileNameEnd=inString(iFileNameStart+10,"""") mFileName=subString(iFileNameStart+10,iFileNameEnd-iFileNameStart-10) iStart=inString(iFileNameEnd+1,vbEnter&vbEnter) iEnd=inString(iStart+4,vbEnter&strDiv) if iEnd>iStart then mFileSize=iEnd-iStart-4 else mFileSize=0 end if set theFile=new FileInfo theFile.FileName=getFileName(mFileName) theFile.FilePath=getFilePath(mFileName) theFile.FileSize=mFileSize theFile.FileStart=iStart+4 theFile.FormName=FormName file.add mFormName,theFile else iStart=inString(iEnd+1,vbEnter&vbEnter) iEnd=inString(iStart+4,vbEnter&strDiv) if iEnd>iStart then mFormValue=subString(iStart+4,iEnd-iStart-4) else mFormValue="" end if form.Add mFormName,mFormValue end if iFormStart=iformEnd+iDivLen iFormEnd=inString(iformStart,strDiv)-1 wend End Sub Private Function subString(theStart,theLen) dim i,c,stemp upfile_5xSoft_Stream.Position=theStart-1 stemp="" for i=1 to theLen if upfile_5xSoft_Stream.EOS then Exit for c=ascB(upfile_5xSoft_Stream.Read(1)) If c > 127 Then if upfile_5xSoft_Stream.EOS then Exit for stemp=stemp&Chr(AscW(ChrB(AscB(upfile_5xSoft_Stream.Read(1)))&ChrB(c))) i=i+1 else stemp=stemp&Chr(c) End If Next subString=stemp End function Private Function inString(theStart,varStr) dim i,j,bt,theLen,str InString=0 Str=toByte(varStr) theLen=LenB(Str) for i=theStart to upfile_5xSoft_Stream.Size-theLen if i>upfile_5xSoft_Stream.size then exit Function upfile_5xSoft_Stream.Position=i-1 if AscB(upfile_5xSoft_Stream.Read(1))=AscB(midB(Str,1)) then InString=i for j=2 to theLen if upfile_5xSoft_Stream.EOS then inString=0 Exit for end if if AscB(upfile_5xSoft_Stream.Read(1))<>AscB(MidB(Str,j,1)) then InString=0 Exit For end if next if InString<>0 then Exit Function end if next End Function Private Sub Class_Terminate form.RemoveAll file.RemoveAll set form=nothing set file=nothing upfile_5xSoft_Stream.close set upfile_5xSoft_Stream=nothing End Sub Private 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 function Private function toByte(Str) dim i,iCode,c,iLow,iHigh toByte="" For i=1 To Len(Str) c=mid(Str,i,1) iCode =Asc(c) If iCode<0 Then iCode = iCode + 65535 If iCode>255 Then iLow = Left(Hex(Asc(c)),2) iHigh =Right(Hex(Asc(c)),2) toByte = toByte & chrB("&H"&iLow) & chrB("&H"&iHigh) Else toByte = toByte & chrB(AscB(c)) End If Next End function End Class Class FileInfo dim FormName,FileName,FilePath,FileSize,FileStart Private Sub Class_Initialize FileName = "" FilePath = "" FileSize = 0 FileStart= 0 FormName = "" End Sub Public function SaveAs(FullPath) dim dr,ErrorChar,i SaveAs=1 if trim(fullpath)="" or FileSize=0 or FileStart=0 or FileName="" then exit function if FileStart=0 or right(fullpath,1)="/" then exit function set dr=CreateObject("Adodb.Stream") dr.Mode=3 dr.Type=1 dr.Open upfile_5xSoft_Stream.position=FileStart-1 upfile_5xSoft_Stream.copyto dr,FileSize dr.SaveToFile FullPath,2 dr.Close set dr=nothing SaveAs=0 end function End Class %> <% function sqlstr(data) if not isnull(data) then sqlstr="'"& replace(data,"'","''") &"'" else sqlstr="'"& data &"'" end if end function %> <% session.CodePage=936 Server.ScriptTimeOut=600000 set upload=new upload_5xsoft set file=upload.file("filexls") %> <% if file.fileSize>0 then filename=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now) filename=filename+"." filenameend=file.filename filenameshow=file.filename filenameend=split(filenameend,".") if filenameend(1)="xls" then filename=filename&filenameend(1) file.saveAs Server.mappath("uploadfiles/"&filename) else response.write "数据格式不对！" response.write "<a href=file_upload.asp>返回" response.end() end if set file=nothing else response.write "文件不能为空！" response.write "<a href=file_upload.asp>返回" response.end() End if set upload=nothing '上传XLS文件结束，下面从上传的XLS文件中读取数据写入到SQL数据库 strAddr=server.MapPath("uploadfiles/"&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 rs=server.CreateObject("adodb.recordset") set rs1=server.CreateObject("adodb.recordset") sql="select * from [Sheet1$]" rs.open sql,excelconn,1,3 if not(rs.bof and rs.eof) then rs.movenext do while not rs.eof 'response.Write(rs(1)) 'response.End() sql1="select * from member" rs1.open sql1,conn,1,3 rs1.addnew Randomize username="" Do While Len(username)<8 '随机密码位数 num1=CStr(Chr((57-48)*rnd+48)) '0~9 'num2=CStr(Chr((90-65)*rnd+65)) 'A~Z num3=CStr(Chr((122-97)*rnd+97)) 'a~z username=username&num1&num3 loop rs1("username")=username rs1("password")="bb0391ec1d7bda99"'bamboo123456 if rs(0)<>"" then rs1("company")=rs(0) end if if rs(1)<>"" then rs1("realname")=rs(1) end if if rs(2)<>"" then rs1("sex")=sexn(rs(2)) end if if rs(3)<>"" then rs1("prof")=rs(3) end if if rs(4)<>"" then rs1("tel")=rs(4) end if if rs(5)<>"" then rs1("mobile")=rs(5) end if if rs(6)<>"" then rs1("address")=rs(6) end if if rs(7)<>"" then rs1("area")=getclassdname(rs(7),"area","cn") end if if rs(8)<>"" then rs1("city")=getclassdname(rs(8),"area","cn") end if if rs(9)<>"" then rs1("fax")=rs(9) end if if rs(10)<>"" then rs1("comtype")=comtypem(rs(10)) end if if rs(11)<>"" then rs1("operation")=rs(11) end if rs1("passed")=1 rs1("activated")=1 rs1("lastlogintime")=now() rs1.update rs1.close rs.movenext loop end if rs.close() set rs=nothing set rs1=nothing excelconn.Close() set excelconn=nothing conn.close() set conn=nothing function sexn(str) select case str case "男" sexn=0 case "女" sexn=1 end select end function function comtypem(str) select case str case "竹制品" comtypem=0 case "竹机械" comtypem=1 end select end function function getclassdname(str,tablename,lang) If Not IsNumeric(id) Then Exit Function set rs2=conn.execute ("select top 1 id from "& tablename &" where classname like '%"&str&"%'") if not rs2.eof Then If lang<>"" Then If lang="cn" Then getclassdname=getclassdname & rs2(0) ElseIf lang="en" Then getclassdname=getclassdname & rs2(0) End If End If else getclassdname=0 end if rs2.close End Function %> <table width="300" border="1" align="center" cellpadding="0" cellspacing="0" bordercolor="#CCCCCC"> <tr> <th bordercolor="#F1F3F8" bgcolor="#999999" class="t" scope="row"> </th> </tr> <tr> <th class="t" scope="row">文件<% response.write (filenameshow) %>导入成功！</th> </tr> <tr> <th class="t" scope="row"><a href="javascript:self.close()" class="t">关闭窗口</a></th> </tr> <tr> <th class="t" scope="row"><a href="1122.asp" class="t">返回</a></th> </tr> </table>