asp上传excle文件并导入到access数据库
作者:wang 日期:2009-12-15
<%
function FSOFileDel(filename)
Dim objFSO,objCountFile,FiletempData
On Error Resume Next
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objCountFile =objFSO.DeleteFile(Server.MapPath(filename),true)
objCountFile.Close
Set objCountFile=Nothing
Set objFSO = Nothing
End Function
dim action,files
action=trim(request("action"))
files=trim(request("files"))
select case action
case "add"
call add(files)
case else
call default()
end select
%>
<%sub default()%>
<%end sub%>
<%
sub add(files)
dim FileName
if files="" then ClientAlert"请先上传Excle文件","?"
FileName="../upload/file/"&files '取得文件路径
Dim connEX
set connEX=CreateObject("ADODB.connection")
connEX.Open "Driver={Microsoft Excel Driver (*.xls)};" & _
"DriverId=790;" & _
"Dbq=" & server.mappath(""&FileName&"") & ";" & _
"DefaultDir=G:\"
set rs=createobject("ADODB.recordset")
rs.Open "Select * From [Sheet1$]",connEX, 2, 2
if rs.eof then
response.write "Excel表中无纪录"
else
' set connDB = Server.CreateObject("ADODB.Connection")
' DBPath = Server.MapPath("excel.mdb")
' 'RESPONSE.WRITE DBpath
' connDB.Open "driver={Microsoft Access Driver (*.mdb)};dbq=" & DBPath
Set RsDB = Server.CreateObject("ADODB.Recordset")
SqlDB="Select * from product"
RsDB.open sqlDB,conn,1,3
do while not rs.eof '利用循环读出数据
RsDB.addnew
RsDB("ProName")=rs(0)
RsDB("ProClassId")=rs(1)
RsDB("ProPics")=rs(2)
RsDB("ProPic")=rs(3)
RsDB("ProFeaturesCn")=rs(4)
RsDB("IsNew")=rs(5)
RsDB("IsHot")=rs(6)
RsDB("Taxis")=rs(7)
Rs.update
RsDB.movenext
rs.movenext
loop
'response.redirect FileName
end if
RsDB.movefirst
if RsDB.eof then
response.write "数据库中无记录"
end if
rs.close
set rs=nothing
set connEX=nothing
Call FSOFileDel("../upload/file/"&files)'导入成功后及时删除上传文件.
ClientAlert"导入成功,点确定继续。","?"
end sub
%>
点击下载此文件
function FSOFileDel(filename)
Dim objFSO,objCountFile,FiletempData
On Error Resume Next
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objCountFile =objFSO.DeleteFile(Server.MapPath(filename),true)
objCountFile.Close
Set objCountFile=Nothing
Set objFSO = Nothing
End Function
dim action,files
action=trim(request("action"))
files=trim(request("files"))
select case action
case "add"
call add(files)
case else
call default()
end select
%>
<%sub default()%>
<%end sub%>
<%
sub add(files)
dim FileName
if files="" then ClientAlert"请先上传Excle文件","?"
FileName="../upload/file/"&files '取得文件路径
Dim connEX
set connEX=CreateObject("ADODB.connection")
connEX.Open "Driver={Microsoft Excel Driver (*.xls)};" & _
"DriverId=790;" & _
"Dbq=" & server.mappath(""&FileName&"") & ";" & _
"DefaultDir=G:\"
set rs=createobject("ADODB.recordset")
rs.Open "Select * From [Sheet1$]",connEX, 2, 2
if rs.eof then
response.write "Excel表中无纪录"
else
' set connDB = Server.CreateObject("ADODB.Connection")
' DBPath = Server.MapPath("excel.mdb")
' 'RESPONSE.WRITE DBpath
' connDB.Open "driver={Microsoft Access Driver (*.mdb)};dbq=" & DBPath
Set RsDB = Server.CreateObject("ADODB.Recordset")
SqlDB="Select * from product"
RsDB.open sqlDB,conn,1,3
do while not rs.eof '利用循环读出数据
RsDB.addnew
RsDB("ProName")=rs(0)
RsDB("ProClassId")=rs(1)
RsDB("ProPics")=rs(2)
RsDB("ProPic")=rs(3)
RsDB("ProFeaturesCn")=rs(4)
RsDB("IsNew")=rs(5)
RsDB("IsHot")=rs(6)
RsDB("Taxis")=rs(7)
Rs.update
RsDB.movenext
rs.movenext
loop
'response.redirect FileName
end if
RsDB.movefirst
if RsDB.eof then
response.write "数据库中无记录"
end if
rs.close
set rs=nothing
set connEX=nothing
Call FSOFileDel("../upload/file/"&files)'导入成功后及时删除上传文件.
ClientAlert"导入成功,点确定继续。","?"
end sub
%>
点击下载此文件
[本日志由 wang 于 2009-12-15 08:14 AM 编辑]
上一篇: 中国情诗名句(转载)下一篇: asp实现rss订阅功能
文章来自: 本站原创
引用通告: 查看所有引用 | 我要引用此文章
Tags:
相关日志:
评论: 0 | 引用: 0 | 查看次数: 4356
发表评论