asp批量导入EXCEL到ACCESS的问题

Question

最近用ASP实现Excel数据批量导入到Access。找到些代码还是不行

dim conn
dim conn2
set conn=CreateObject("ADODB.Connection")
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=;Data Source=Database/cq#%&_#&db5$5#6.asp"

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

sql = "select * FROM [Sheet1$]"
set rs = conn2.execute(sql)
while not rs.eof
sql = "insert into News([ID],[Title],[Video],[BigClass],[BigClassName],[SmallClass],[SmallClassName]) values('"& fixsql(rs(0)) &"','"& fixsql(rs(1)) &"','"& fixsql(rs(2)) &"','"& fixsql(rs(3)) &"','"& fixsql(rs(4)) &"','"& fixsql(rs(5)) &"','"& fixsql(rs(6)) &"')"
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

Answer 1

<% dim exceldb
exceldb=SavePath&FileName '获取传递过来的值
Dim StrConnect,ccid,excelstr,rsc
ccid=0
'Excel连接驱动
excelstr="provider=Microsoft.Jet.OLEDB.4.0; Data Source="&server.mappath(exceldb)&";Extended Properties=Excel 8.0"
'excelstr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath( "book1.xls" )&";Extended Properties='Excel 8.0;HDR=NO';" '可以读取第一行记录
set StrConnect=CreateObject("ADODB.Connection")
StrConnect.Open excelstr
adSchemaTables=20
set rst = StrConnect.OpenSchema(adSchemaTables)
'注意 表名一定要以下边这种格试 "[表名$]" 书写
Set rsc = Server.CreateObject("ADODB.Recordset")
Sqlc="select * from ["&rst("Table_Name").Value&"]"
rsc.Open Sqlc,StrConnect,2,2
if rsc.bof and rsc.eof then
Response.write "<script language='javascript'>" & chr(13)
Response.write "alert('导入数据失败,没有数据可以导入,请检查您的Excel文件!');history.go(-1);" & Chr(13)
Response.write "</script>" & Chr(13)
Response.End
else
sql="select [id] from [content] where [dn] like '"&yy&"%' or ([Gdate]='"&trim(rsc(0))&"' and [gtime]='"&trim(rsc(1))&"' and [buyerid]='"&trim(rsc(29))&"')"
set rss=conn.execute(sql)
if not(rss.bof and rss.eof) then
Response.write "<script language='javascript'>" & chr(13)
Response.write "alert('导入数据失败,数据库已存在此数据!');history.go(-1);" & Chr(13)
Response.write "</script>" & Chr(13)
Response.End
else
dim rs,sq
rsc.movefirst
do while not rsc.eof
ccid=ccid+1
dim mm
mm=ccid
for a=1 to 5
if len(mm)<5 then
mm="0"&cstr(mm)
else
mm=yy&mm
exit for
end if
next

dim nn,kk
set rsn=conn.execute("select [img_url],[p_name],[p_num] from [BuNengSan] where [p_name]='"&strkill(trim(rsc(19)))&"'")
if rsn.bof and rsn.eof then
nn="未知"
kk="upproduct/defeat.gif"
else
nn=rsn("p_num")
kk=rsn("img_url")
end if
rsn.close
set rsn=nothing

dim jj
if rsc(8)<0 then
jj=0
else
jj=1
end if

dim aa
if trim(rsc(36))="" or isnull(trim(rsc(36))) then
aa=0
else
aa=trim(rsc(36))
end If

Dim dd
If trim(rsc(46))="" Or IsNull(trim(rsc(46))) Then
dd="未知"
Else
If InStr(trim(rsc(46)),",")>0 Then
dd=trim(rsc(46))
Else
dd=Trim(Replace(trim(rsc(46)),"A",""))
End if
End if

sq="select * from [content] where ID is Null"
set rs=server.createobject("adodb.recordset")
rs.open sq,conn,1,3
rs.addnew
rs("dn")=trim(mm)
rs("sku")=trim(nn)
rs("img_url")=trim(kk)
rs("Gdate")=trim(rsc(0))
rs("gtime")=trim(rsc(1))
rs("Gname")=strkill(trim(rsc(3)))
rs("Status")=trim(rsc(5))
rs("cross")=cint(jj)
rs("pname")=strkill(trim(rsc(19)))
rs("note")=trim(rsc(11))
rs("Email")=trim(rsc(12))
rs("IID")=dd
rs("qc")="未指定"
rs("buyerid")=trim(rsc(29))
rs("pnum")=cint(aa)
rs("add1")=trim(rsc(38))
rs("add2")=trim(rsc(39))
rs("add3")=trim(rsc(40))
rs("add4")=trim(rsc(41))
rs("add5")=trim(rsc(42))
rs("cadd")=trim(rsc(43))
rs.update
rsc.movenext
loop

Response.write "<script language='javascript'>" & chr(13)
Response.write "alert('导入数据成功!');" & Chr(13)
'Response.write "window.opener.location.reload();"&Chr(13)
Response.write "window.opener.location.href=window.opener.location.href;"&Chr(13)
Response.write "window.close();"&Chr(13)
Response.write "</script>" & Chr(13)
Response.End

end if
rss.close
set rss=nothing
end if
rsc.close
set rsc=nothing

%>

Answer 2

我整理改写的代码，基本包含了excel所需要的各种元素的说明。
http://hi.baidu.com/superfeng/blog/item/53d68e4490d7684a500ffe7f.html

Answer 3

这么高级的应用应该很少人用..