ASP import Excel data into SQL Server implementation code _ Application Tips

Copy Code code as follows:

<form action= "insert.asp" method= "post" enctype= "Multipart/form-data" Name= "Form1" onsubmit= "B1_onclick" () >
<table width= "border=" 1 "align=" center "cellpadding=" 0 "cellspacing=" 0 ">
<tr>
&LT;TD colspan= "2" bgcolor= "#999999" class= "T" > select File
</td>
</tr>
<tr>
&LT;TD colspan= "2" class= "T" > </td>
</tr>
<tr>
&LT;TD width= "126" class= "T" > select file (Excel)
</td>
&LT;TD width= "368" class= "T" ><label>
<input name= "Filexls" type= "file" size= ">"
</label></td>
</tr>
<tr>
&LT;TD colspan= "2" class= "T" >
<label>
<input type= "Submit" name= "Submit" value= "Import Data" >
</label>
<a href= "1122.asp" class= "T" > Return </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= "Ren Xiang Special Upload program"
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 (&AMP;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&AMP;CHR (AscW (ChrB (AscB (Upfile_5xsoft_stream.read (1)) &AMP;CHRB (c)))
I=i+1
Else
STEMP=STEMP&AMP;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)) &LT;&GT;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-&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 "Data format is wrong!" "
Response.Write "<a href=file_upload.asp> return"
Response.End ()
End If
Set file=nothing
Else
Response.Write "File cannot be empty! "
Response.Write "<a href=file_upload.asp> return"
Response.End ()
End If
Set upload=nothing
' Upload xls file end, read data from uploaded XLS file to SQL database
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 as 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 ' Random password digits
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 <> "" Then
Rs1 ("ComType") =comtypem (RS (10))
End If
If RS (one) <> "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 "Male"
Sexn=0
Case "female"
Sexn=1
End Select
End Function
function Comtypem (str)
Select Case Str
Case "Bamboo Products"
Comtypem=0
Case "Bamboo Machinery"
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 IDs 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= "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" > File <% Response.Write (filenameshow)%> Import succeeded! </th>
</tr>
<tr>
<th class= "T" scope= "row" ><a href= "Javascript:self.close ()" class= "T" > Close window </a></th>
</tr>
<tr>
<th class= "T" scope= "row" ><a href= "1122.asp" class= "T" > Return </a></th>
</tr>
</table>