Implementation Code for ASP to import Excel Data to SQLServer

Source: Internet
Author: User

Copy codeThe Code is as follows: <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"> select a file
</Td>
</Tr>
<Tr>
<Td colspan = "2" class = "t"> </td>
</Tr>
<Tr>
<Td width = "126" class = "t"> select a file (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 = "import data">
</Label>
<A href = "Limit 2.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 dedicated 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 (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
C = ascB (upfile_5xSoft_Stream.Read (1 ))
If c & gt; 127 Then
If upfile_5xSoft_Stream.EOS then Exit
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
End if
If AscB (upfile_5xSoft_Stream.Read (1) <> AscB (MidB (Str, j, 1) then
InString = 0
Exit
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, limit Rev (FullPath ,"\"))
Else
GetFilePath = ""
End If
End function
Private function GetFileName (FullPath)
If FullPath <> "" Then
GetFileName = mid (FullPath, limit Rev (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 "the data format is incorrect! "
Response. write "<a href = file_upload.asp> return"
Response. end ()
End if
Set file = nothing
Else
Response. write "file cannot be blank! "
Response. write "<a href = file_upload.asp> return"
Response. end ()
End if
Set upload = nothing
'After the XLS file is uploaded, data is read from the uploaded XLS file and written to the 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 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' random password count
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 "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 rs2logs conn.exe cute ("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"> file <% response. write (filenameshow) %> imported successfully! </Th>
</Tr>
<Tr>
<Th class = "t" scope = "row"> <a href = "javascript: self. close () "class =" t "> close the window </a> </th>
</Tr>
<Tr>
<Th class = "t" scope = "row"> <a href = "define 2.asp" class =" t "> return </a> </th>
</Tr>
</Table>
Related Article

Contact Us

The content source of this page is from Internet, which doesn't represent Alibaba Cloud's opinion; products and services mentioned on that page don't have any relationship with Alibaba Cloud. If the content of the page makes you feel confusing, please write us an email, we will handle the problem within 5 days after receiving your email.

If you find any instances of plagiarism from the community, please send an email to: info-contact@alibabacloud.com and provide relevant evidence. A staff member will contact you within 5 working days.

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.