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>