asp将excel的内容导入到access
最近想把asp的东西全部整理下,毕竟这么多年没有动asp了,给它画个句号。发现了一段代码可以将excel的东西转移到access中去:ExcelToAccess.asp。
<%
option explicit
dim conn
set conn = Server.CreateObject("ADODB.Connection")
conn.ConnectionString = "provider=Microsoft.Jet.OLEDB.4.0;"
conn.Open "Data Source=" & server.MapPath("db.mdb")
'目前正确的函数版本
sub testExcel ()
'=========================================
'定义
dim myConnection
dim strName
dim rsXsl,rsSql
dim myConn_Xsl
dim i,j
dim maxId
dim strSheetName,str_Xsl,str_Sql
strSheetName = "sheet1"
strName = server.MapPath("unfurl_total.xls") 'strFileName
set myConnection = Server.CreateObject("ADODB.Connection")
set rsXsl = Server.CreateObject("ADODB.Recordset")
set rsSql = Server.CreateObject("ADODB.Recordset")
dim rs,sql
sql = "select * from fujian where fujian_id = 0 ;"
set rs = Server.CreateObject("ADODB.Recordset")
rs.Open sql,conn,1,3
myConn_Xsl = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strName & _
";Extended Properties=Excel 8.0"
'打开连接
myconnection.open myConn_Xsl
'打开表
str_Xsl = "select * from [" & strSheetName & "$]"
rsXsl.open str_Xsl,myconnection,1,1
j = 1
Do while not rsXsl.eof
rs.AddNew
'response.write rsXsl(0) & "/// " & rsXsl(1) & "/// " & rsXsl(2) & "/// " & rsXsl(3) & "/// " & rsXsl(4) & "/// " & _
' rsXsl(5) & "/// " & rsXsl(6) & "/// " & "<br>"
rs("p1") = rsXsl(0)
rs("p2") = rsXsl(1)
rs("p3") = rsXsl(2)
rs("p4") = rsXsl(3)
rs("p5") = rsXsl(4)
rs("p6") = rsXsl(5)
rs("p7") = rsXsl(6)
'rs("p8") = rsXsl(7)
rs.Update
rsXsl.moveNext
j = j + 1
loop
response.write "共导入 " & j-1 & " 条记录.<br>"
response.write "<a href=# onclick='self.close();'>关闭窗口</a>"
set rsXsl = nothing
set rsSql = nothing
set myconnection = nothing
'set cmd = nothing
end sub
Call testExcel ()
%>
<%
option explicit
dim conn
set conn = Server.CreateObject("ADODB.Connection")
conn.ConnectionString = "provider=Microsoft.Jet.OLEDB.4.0;"
conn.Open "Data Source=" & server.MapPath("db.mdb")
'目前正确的函数版本
sub testExcel ()
'=========================================
'定义
dim myConnection
dim strName
dim rsXsl,rsSql
dim myConn_Xsl
dim i,j
dim maxId
dim strSheetName,str_Xsl,str_Sql
strSheetName = "sheet1"
strName = server.MapPath("unfurl_total.xls") 'strFileName
set myConnection = Server.CreateObject("ADODB.Connection")
set rsXsl = Server.CreateObject("ADODB.Recordset")
set rsSql = Server.CreateObject("ADODB.Recordset")
dim rs,sql
sql = "select * from fujian where fujian_id = 0 ;"
set rs = Server.CreateObject("ADODB.Recordset")
rs.Open sql,conn,1,3
myConn_Xsl = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strName & _
";Extended Properties=Excel 8.0"
'打开连接
myconnection.open myConn_Xsl
'打开表
str_Xsl = "select * from [" & strSheetName & "$]"
rsXsl.open str_Xsl,myconnection,1,1
j = 1
Do while not rsXsl.eof
rs.AddNew
'response.write rsXsl(0) & "/// " & rsXsl(1) & "/// " & rsXsl(2) & "/// " & rsXsl(3) & "/// " & rsXsl(4) & "/// " & _
' rsXsl(5) & "/// " & rsXsl(6) & "/// " & "<br>"
rs("p1") = rsXsl(0)
rs("p2") = rsXsl(1)
rs("p3") = rsXsl(2)
rs("p4") = rsXsl(3)
rs("p5") = rsXsl(4)
rs("p6") = rsXsl(5)
rs("p7") = rsXsl(6)
'rs("p8") = rsXsl(7)
rs.Update
rsXsl.moveNext
j = j + 1
loop
response.write "共导入 " & j-1 & " 条记录.<br>"
response.write "<a href=# onclick='self.close();'>关闭窗口</a>"
set rsXsl = nothing
set rsSql = nothing
set myconnection = nothing
'set cmd = nothing
end sub
Call testExcel ()
%>