asp實(shí)現excel中的數據導入數據庫

asp實(shí)現excel中的數據導入數據庫

<% Response.CodePage=65001%>
<% Response.Charset="UTF-8" %>
<%
wenjian = request.Form("select")
 
'獲取文件擴展名
ext = FileExec(wenjian)
'判斷文件擴展名
if ext <> "xls" then
  response.Write("<script>alert('文件類(lèi)型不對，請核實(shí)！');window.location.href='index.html';</script>")
  response.End()
end if
 
Dim objConn,objRS
Dim strConn,strSql
 
set objConn=Server.CreateObject("ADODB.Connection")
set objRS=Server.CreateObject("ADODB.Recordset")
 
excelFile = server.mappath(wenjian) 
'針對excel 2007
strConn = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & excelFile & ";" & "Extended Properties=Excel 8.0;"
objConn.Open strConn
 
strSql="SELECT * FROM [Sheet1$]"
 
objRS.Open strSql,objConn,1,1
objRS.MoveFirst
 
%><!--#include file="conn.asp"--><%
'循環(huán)excel中所有記錄
while not objRS.eof
 
  set rs = Server.CreateObject("Adodb.Recordset")
  '查詢(xún)語(yǔ)句
  sql_s = "select * from ceshi where lname='" & objRS(0) & "' and old='" & objRS(1) & "' and sex='" & objRS(2) & "' and guojia='" & objRS(3) & "' and QQ='" & objRS(4) & "'"
  rs.open sql_s, conn, 1, 1
  '重復的數據不做錄入操作
  if rs.eof then
    '插入語(yǔ)句
    '****excel中第一條不會(huì )被錄入****
    sql = "insert into ceshi (lname, old, sex, guojia, QQ)values ('" & objRS(0) & "', '" & objRS(1) & "', '" & objRS(2) & "', '" & objRS(3) & "', '" & objRS(4) & "')"
    '執行插入
    conn.execute(sql)
  end if
  objRS.MoveNext 
  rs.close
  set rs = nothing
wend
 
'又到了各種關(guān)閉的時(shí)候
conn.close
set conn = nothing
objRS.Close
objConn.Close
set objRS = Nothing
set objConn = Nothing
 
response.Write("<script>alert('導入成功');window.location.href='index.html';</script>")
response.End()
 
Function FileExec(fileName)
 FileExec = Mid(fileName,Instr(fileName,".")+1,Len(fileName)-Instr(fileName,"."))
End Function
%>

再分享一個(gè)簡(jiǎn)化版的代碼

wenjian=request.Form("floor")
		fileext=mid(wenjian,InStrRev(wenjian,".")+1)
		if lcase(fileext)<>"xls" then
			response.write "<script>alert ('文件格式不對，請上傳Excel文件');window.location.href='updateFloor.asp';</script>"
			response.end
		end if
		set conne=server.CreateObject("ADODB.Connection")
		connStre="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath( ""&wenjian&"" )&";Extended Properties='Excel 8.0;HDR=YES;IMEX=1';"
		conne.open connStre
		Sqle="select * from [sheet1$] " 
		Set rse = Server.CreateObject("ADODB.Recordset")
		rse.open sqle,conne,1,1
		'驗證
		hang=2
		do while not rse.eof
		'名稱(chēng)不能為空
			if trim(rse(0))<>"" then
			else
				mess="第"& hang &"行名稱(chēng)為空，請檢查！"
				response.Write"<script>alert('"& mess &"').window.location.href='updateFloor.asp'</script>"
				response.End()
			end if 
			rse.movenext
			hang=hang+1
		loop
		rse.movefirst
		do while not rse.eof
			set rst=server.CreateObject("adodb.recordset")
			sqlt="select * from Sellman"
			rst.open sqlt,conn,1,3
			rst.addnew()
			rst("CompanyName")=c2(rse(0))
			rst("CompanyInfo")=c2(rse(1))
			rst("address")=c2(rse(2))
			rst("tel")=c2(rse(3))&"&nbsp;&nbsp;"&c2(rse(7))
			rst("Fax")=c2(rse(4))
			rst("linkman")=c2(rse(5))
			rst("Homepage")=c2(rse(8))
			rst("Email")=c2(rse(6))
			rst.update()
			rst.close
			set rst=nothing
			rse.movenext
		loop
		rse.close
		set rse=nothing
		response.Write "<script>alert('導入成功!');location.href='updateFloor.asp';</script>"

其實(shí)簡(jiǎn)單的說(shuō)象access 數據庫一樣,把excel文件打開(kāi),再進(jìn)行讀再寫(xiě)到access中你要寫(xiě)到sqlserver中就把寫(xiě)的過(guò)程改一下就成了

看下代碼：

dim conn 
dim conn2 
set conn=CreateObject("ADODB.Connection") 
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=;Data Source=c:\book1.mdb" 

set conn2=CreateObject("ADODB.Connection") 
conn2.Open "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=;Extended properties=Excel 5.0;Data Source=c:\book1.xls" 


sql = "SELECT * FROM [Sheet1$]" 
set rs = conn2.execute(sql) 
while not rs.eof 
sql = "insert into xxx([a],[b],[c],[d]) values('"& fixsql(rs(0)) &"','"& fixsql(rs(1)) &"','"& fixsql(rs(2)) &"','"& fixsql(rs(3)) &"')" 
conn.execute(sql) 
rs.movenext 
wend 

conn.close 
set conn = nothing 
conn2.close 
set conn2 = nothing 

function fixsql(str) 
dim newstr 
newstr = str 
if isnull(newstr) then 
newstr = "" 
else 
newstr = replace(newstr,"'","''") 
end if 
fixsql = newstr 
end function