求助Excel数据导入到ACCESS数据库的方法!

时间:2022-10-20 14:42:51
求助Excel数据导入到ACCESS数据库的方法!
电子表格 文件是 xuesheng.xls 内有A B C D E 等内容
用ASP文件在线导入ACCESS数据库sfxy.mdb内中的表sysy中!

其中xls电子表格中
A列内容导入数据库中的第一个字段(rs(0));
B列内容导入数据库中的第一个字段(rs(1))
C列内容导入数据库中的第一个字段(rs(2))
D列内容导入数据库中的第一个字段(rs(3))
依次类推......

曾得到一段ASP代码如下:
<%
dim conn
dim conn2
set conn=CreateObject("ADODB.Connection")
conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password=;Data Source=F:\web\sfxy.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=F:\web\xuesheng.xls"


sql = "SELECT * FROM [sfsf]" 
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
%>

运行提示错误:

Microsoft JET Database Engine 错误 '80040e37' 

Microsoft Jet 数据库引擎找不到对象'sfsf'。请确定对象是否存在,并正确地写出它的名称和路径。 

web/access.asp,行 12 

请高人指点迷精,或者重新写代码帮助,谢谢!

16 个解决方案

#1


<%
sub dataIntoSqlServer_ceritificate(strFileName,strSheetName,myConn)
    '定义
    dim myConnection
    dim strName
    dim rsXsl,rsSql
    dim str_Xsl,str_Sql
    dim myConn_Xsl
    dim cmd
    dim i,j
    dim maxId

    strName=strFileName 
    set myConnection=server.createobject("adodb.connection")
    set rsXsl=Server.Createobject("ADODB.Recordset")
    set rsSql=Server.CreateObject("ADODB.Recordset")
    set cmd=Server.CreateObject("ADODB.Command")
cmd.ActiveConnection=myConn


 
    myConn_Xsl="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strName & ";Extended Properties=Excel 8.0" 

'myConn_Xsl="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Application("ASP_Directory") & "chapter05\database\" & 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
    '取出最大值
    str_Sql="select Max(id) as maxId from new"
    rsSql.open str_Sql,myConn,1,3
    If Not rsSql.Eof Then
       If not isNull(rsSql("maxId")) Then
          maxId=Clng(rsSql("maxId"))+1
    Else
       maxId=1
    End if
    else
       maxId=1
    End if
    rsSql.close'//关闭对象
'加入数据库
strqbsr=""
yssr=""
str_Sql="insert into new values("&maxId&",'"&rsXsl(1)&"','"&rsXsl(2)&"','"&rsXsl(3)&"','"&rsXsl(4)&"','"&rsXsl(5)&"','"&rsXsl(6)&"','"&rsXsl(7)&"','"&rsXsl(8)&"','"&rsXsl(9)&"','"&rsXsl(10)&"','"&rsXsl(11)&"','"&rsXsl(12)&"','"&rsXsl(13)&"','"&rsXsl(14)&"','"&rsXsl(15)&"','"&rsXsl(16)&"','"&strqbsr&"','"&yssr&"')" 
    cmd.CommandText=str_Sql
    cmd.Execute()                       
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
         j=j+1
    rsXsl.movenext 
    Loop

    response.write "共导入<font color='red'>" & j-1 & "</font>条记录.<br>"
    response.write "<a href=javascript:history.back()>确定</a>" 
    set rsXsl=nothing 
    set rsSql=nothing
    set myconnection=nothing 
    set cmd=nothing 
end sub

file1="'"&request.form("filename2")&"'"
strtj=mid(request.form("filename2"),instrrev(file1,"\"),(instrrev(file1,".")-instrrev(file1,"\")-1)) 
if file1="" then
 response.write "请选择您要导入的Excel表!<p></p>"   
%>
<a href=javascript:history.back()>上一页</a>
<%
    response.end
   end if
'respons.write "'"&request.form("filename")&"'"
myconn="DRIVER={SQL SERVER};SERVER=(local);uid=sa;pwd=sa;DATABASE=qjgsj_data"
dataIntoSqlServer_ceritificate  file1,""&strtj&"",myconn

%>

给分吧.

#2


确认机器支持吗?

#3


zhanghongwen(流氓蚊子):你好,运行提示
Microsoft VBScript 运行时错误 错误 '800a0005' 

无效的过程调用或参数: 'mid' 

/web/access.asp,行 66 


intereye(把代码写成诗):你好:我系统是2003,IIS运行正常,数据库所在目录权限支持写入...

#4


没必要用程序来做,你可以借助sqlserver把excel导入到access

#5


sibang(好好学习-天天想上!) :直接导入是很方便,但是网站应用需要客户远程导入数据,所以必须用ASP程序制作的!

#6


up

#7


继续啊朋友

#8


file1="'"&request.form("filename2")&"'"
strtj=mid(request.form("filename2"),instrrev(file1,"\"),(instrrev(file1,".")-instrrev(file1,"\")-1)) 
if file1="" then
 response.write "请选择您要导入的Excel表!<p></p>"   
你难道不会自己看一下代码吗?
这是先在前一个页面加一上文件选择框选择文件之后再导.不要太依靠别人,自己也要学着改呀.

#9


zhanghongwen(流氓蚊子):您好,真是不好意思,我是初学者,对代码不是很明白!SORRY!

希望能写全面代码给我,包括提交页面,还有代码中的数据库路径、表名!

感激不尽!先行谢谢了!

ACCESS数据库路径是f://web/sfxy.mdb ,里面的表名是sfsf 
字段1:ID
字段2:帐号
字段3:密码

#10


我被你晕死了,你写的很模糊,我都没弄明白你是将Excel数据导入到ACCESS,还是说用ACCESS导出到Excel表中.
提供一下我修改的你的源码后,做的测试文档,并通过验证了:
<%
Dim cn : Set cn = Server.CreateObject("ADODB.Connection")
Dim strConn, strLogin, strPassword
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Persist Security Info=False;Data Source="&server.mappath("./City.mdb")  '当前目录下的City数据库
strLogin = "Admin"
strPassword = ""
cn.open strConn, strLogin, strPassword

Set conn = server.CreateObject("ADODB.Connection") 
dbPath=server.MapPath("City.xls") '当前目录下的City工作簿
conn.Open "driver={Microsoft Excel Driver (*.xls)};dbq="&dbPath 

Set rs = Server.CreateObject("ADODB.Recordset") 
rs.Open "[average1$]", conn, 1,1  '打开Excel中的average1工作表,

do while not rs.eof   '逐条将信息插入到City数据库中的City表中
sql = "insert into City(Year_ID,Reg_ID) values('"&rs(0)&"','"& rs(1)&"')"
cn.execute(sql)
rs.movenext
loop

cn.close  '关闭Connection
set cn = nothing
conn.close
set conn = nothing
%>

#11


canning92(追風浪星):您好,按照你的代码已经成功的将XLS导入ACCESS了!谢谢你!
最后,你能加个提交页面吗?因为客户需要调用本地XLS导入远程ACCESS,必要要做提交页面的!

#12


一起学习

#13


up

#14


我現在用的,絕對OK
excel_function.asp是幾個字段的處理結果,就是SQL語句里的幾個session值

<%Server.ScriptTimeout = 9999%>
<!--#include file="excel_function.asp"-->
<html>
<head>
<title>上傳員工資料</title>
<link type="text/css" href="css.css" rel="stylesheet">
<meta http-equiv="Content-Type" content="text/html; charset=big5">
</head>
<body text="#000000" leftmargin="5" topmargin="5" bgcolor="#FFFFFF">
<table width="350" border="1" cellspacing="10" cellpadding="10" bordercolor="#CCCCCC" height="250">
  <tr> 
  <td width="388" bgcolor="#f7f7f7" align="center"> 
<%
call daoru()
sub daoru()
dim objConn,objRs
dim strValue1,strValue2,strValue3,strValue4,strValue5,strValue6,strValue7,strValue8,strValue9,strValue11
Set objConn = Server.CreateObject("ADODB.Connection")
objConn.Provider = "Microsoft.Jet.OLEDB.4.0 "
objConn.ConnectionString ="Data Source='"&server.MapPath("ExcelFile/BOOK.xls")&"';Extended Properties=Excel 8.0;"
objConn.Open


Set objRs=server.CreateObject("ADODB.Recordset")
objRs.Open "select * from [Sheet1$]",objConn,1,3



If Not objRs.EOF Then
'Response.Write "正在添加中...請稍後(此時不能關閉)"
While Not objRs.EOF

'A  編號  No ID
changqu_id = trim(objRs(1).Value) 'B  廠區  Dept Loation 
Dept_name = trim(objRs(2).Value) 'C  部門  Dept Descr
office_num = trim(objRs(3).Value) 'D  課別編碼  DeptID
office_name = trim(objRs(4).Value) 'E  課別名稱  Dept Chinese Descr
employee_number = trim(objRs(5).Value) 'F  工號  ID
name = trim(objRs(6).Value) 'G  姓名  Name
grade = trim(objRs(7).Value) 'H  級別  Grade
work_phone = trim(objRs(8).Value) 'I  電話  Work Phone
user_name = trim(objRs(9).Value) 'J  帳號  User Name
mail = trim(objRs(10).Value) 'K  郵箱  Email Address
Dept_num = trim(objRs(11).Value) 'L  部門編號  1st Level DeptID
director_Dept_name = trim(objRs(12).Value) 'M  部門名稱  1st Level DeptName
director_number = trim(objRs(13).Value) 'N  主管工號  1st Level Mgr ID
director_name = trim(objRs(14).Value) 'O  主管姓名  1st Level Name
director_user = trim(objRs(15).Value) 'P  主管帳號  1st Level UserName
user_pwd="77804d2ba1922c33"

if trim(changqu_id)<>"" then
 call changqu(changqu_id,office_num)
end if

if trim(Dept_name)<>"" then
 call dept(Dept_name,office_num,changqu_id)
end if

if trim(office_name)<>"" then
 call office(office_name,office_num)
end if

if trim(office_num)<>"" then
 call director_if(office_num)
end if
'office(strValue2)

Set rs = CONN.EXECUTE("select employee_number from employee where employee_number='"&employee_number&"'")
if not(rs.bof and rs.eof) then
sql_user_add = "UPDATE employee SET Location_id='"&session("Location_id")&"',dept_id='"&session("dept_id")&"',office_id='"&session("office_id")&"',name='"&name&"',grade='"&grade&"',work_phone='"&work_phone&"',user_name='"&user_name&"',mail='"&mail&"',director_number='"&director_number&"',director_if='"&session("director_if")&"',user_pwd='"&user_pwd&"' where employee_number='"&employee_number&"'"
else
sql_user_add="INSERT INTO employee (Location_id,dept_id,office_id,employee_number,name,grade,work_phone,user_name,mail,director_number,director_if,state,user_pwd) VALUES ('"&session("Location_id")&"','"&session("dept_id")&"','"&session("office_id")&"','"&employee_number&"','"&name&"','"&grade&"','"&work_phone&"','"&user_name&"','"&mail&"','"&director_number&"','"&session("director_if")&"',1,'"&user_pwd&"')"
end if
'Response.Write sql_user_add&"<br>"
if trim(employee_number)<>"" then
  MSSQL_EXECUTE(sql_user_add)
end if

objRs.MoveNext
i=i+1
Wend
End If
Response.Write "<script language=javascript>alert('資料導入成功...');opener.location.reload();self.close();</script>"
'response.write "<script language=javascript>alert('資料導入成功...');window.close();</script>"
end sub
%>
  </td>
  </tr>
</table>
</body>
</html>

#15


也可以加我的QQ1362174

#16


经过wxcyz(阿图)通过QQ耐心详细的帮助,终于最圆满的解决了这个贴问题!给80分!

canning92(追風浪星)的代码也能解决导入问题,再次感谢!给15分

也感谢zhanghongwen(流氓蚊子)提供的帮助,给5分!

#1


<%
sub dataIntoSqlServer_ceritificate(strFileName,strSheetName,myConn)
    '定义
    dim myConnection
    dim strName
    dim rsXsl,rsSql
    dim str_Xsl,str_Sql
    dim myConn_Xsl
    dim cmd
    dim i,j
    dim maxId

    strName=strFileName 
    set myConnection=server.createobject("adodb.connection")
    set rsXsl=Server.Createobject("ADODB.Recordset")
    set rsSql=Server.CreateObject("ADODB.Recordset")
    set cmd=Server.CreateObject("ADODB.Command")
cmd.ActiveConnection=myConn


 
    myConn_Xsl="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strName & ";Extended Properties=Excel 8.0" 

'myConn_Xsl="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Application("ASP_Directory") & "chapter05\database\" & 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
    '取出最大值
    str_Sql="select Max(id) as maxId from new"
    rsSql.open str_Sql,myConn,1,3
    If Not rsSql.Eof Then
       If not isNull(rsSql("maxId")) Then
          maxId=Clng(rsSql("maxId"))+1
    Else
       maxId=1
    End if
    else
       maxId=1
    End if
    rsSql.close'//关闭对象
'加入数据库
strqbsr=""
yssr=""
str_Sql="insert into new values("&maxId&",'"&rsXsl(1)&"','"&rsXsl(2)&"','"&rsXsl(3)&"','"&rsXsl(4)&"','"&rsXsl(5)&"','"&rsXsl(6)&"','"&rsXsl(7)&"','"&rsXsl(8)&"','"&rsXsl(9)&"','"&rsXsl(10)&"','"&rsXsl(11)&"','"&rsXsl(12)&"','"&rsXsl(13)&"','"&rsXsl(14)&"','"&rsXsl(15)&"','"&rsXsl(16)&"','"&strqbsr&"','"&yssr&"')" 
    cmd.CommandText=str_Sql
    cmd.Execute()                       
            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
         j=j+1
    rsXsl.movenext 
    Loop

    response.write "共导入<font color='red'>" & j-1 & "</font>条记录.<br>"
    response.write "<a href=javascript:history.back()>确定</a>" 
    set rsXsl=nothing 
    set rsSql=nothing
    set myconnection=nothing 
    set cmd=nothing 
end sub

file1="'"&request.form("filename2")&"'"
strtj=mid(request.form("filename2"),instrrev(file1,"\"),(instrrev(file1,".")-instrrev(file1,"\")-1)) 
if file1="" then
 response.write "请选择您要导入的Excel表!<p></p>"   
%>
<a href=javascript:history.back()>上一页</a>
<%
    response.end
   end if
'respons.write "'"&request.form("filename")&"'"
myconn="DRIVER={SQL SERVER};SERVER=(local);uid=sa;pwd=sa;DATABASE=qjgsj_data"
dataIntoSqlServer_ceritificate  file1,""&strtj&"",myconn

%>

给分吧.

#2


确认机器支持吗?

#3


zhanghongwen(流氓蚊子):你好,运行提示
Microsoft VBScript 运行时错误 错误 '800a0005' 

无效的过程调用或参数: 'mid' 

/web/access.asp,行 66 


intereye(把代码写成诗):你好:我系统是2003,IIS运行正常,数据库所在目录权限支持写入...

#4


没必要用程序来做,你可以借助sqlserver把excel导入到access

#5


sibang(好好学习-天天想上!) :直接导入是很方便,但是网站应用需要客户远程导入数据,所以必须用ASP程序制作的!

#6


up

#7


继续啊朋友

#8


file1="'"&request.form("filename2")&"'"
strtj=mid(request.form("filename2"),instrrev(file1,"\"),(instrrev(file1,".")-instrrev(file1,"\")-1)) 
if file1="" then
 response.write "请选择您要导入的Excel表!<p></p>"   
你难道不会自己看一下代码吗?
这是先在前一个页面加一上文件选择框选择文件之后再导.不要太依靠别人,自己也要学着改呀.

#9


zhanghongwen(流氓蚊子):您好,真是不好意思,我是初学者,对代码不是很明白!SORRY!

希望能写全面代码给我,包括提交页面,还有代码中的数据库路径、表名!

感激不尽!先行谢谢了!

ACCESS数据库路径是f://web/sfxy.mdb ,里面的表名是sfsf 
字段1:ID
字段2:帐号
字段3:密码

#10


我被你晕死了,你写的很模糊,我都没弄明白你是将Excel数据导入到ACCESS,还是说用ACCESS导出到Excel表中.
提供一下我修改的你的源码后,做的测试文档,并通过验证了:
<%
Dim cn : Set cn = Server.CreateObject("ADODB.Connection")
Dim strConn, strLogin, strPassword
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;Persist Security Info=False;Data Source="&server.mappath("./City.mdb")  '当前目录下的City数据库
strLogin = "Admin"
strPassword = ""
cn.open strConn, strLogin, strPassword

Set conn = server.CreateObject("ADODB.Connection") 
dbPath=server.MapPath("City.xls") '当前目录下的City工作簿
conn.Open "driver={Microsoft Excel Driver (*.xls)};dbq="&dbPath 

Set rs = Server.CreateObject("ADODB.Recordset") 
rs.Open "[average1$]", conn, 1,1  '打开Excel中的average1工作表,

do while not rs.eof   '逐条将信息插入到City数据库中的City表中
sql = "insert into City(Year_ID,Reg_ID) values('"&rs(0)&"','"& rs(1)&"')"
cn.execute(sql)
rs.movenext
loop

cn.close  '关闭Connection
set cn = nothing
conn.close
set conn = nothing
%>

#11


canning92(追風浪星):您好,按照你的代码已经成功的将XLS导入ACCESS了!谢谢你!
最后,你能加个提交页面吗?因为客户需要调用本地XLS导入远程ACCESS,必要要做提交页面的!

#12


一起学习

#13


up

#14


我現在用的,絕對OK
excel_function.asp是幾個字段的處理結果,就是SQL語句里的幾個session值

<%Server.ScriptTimeout = 9999%>
<!--#include file="excel_function.asp"-->
<html>
<head>
<title>上傳員工資料</title>
<link type="text/css" href="css.css" rel="stylesheet">
<meta http-equiv="Content-Type" content="text/html; charset=big5">
</head>
<body text="#000000" leftmargin="5" topmargin="5" bgcolor="#FFFFFF">
<table width="350" border="1" cellspacing="10" cellpadding="10" bordercolor="#CCCCCC" height="250">
  <tr> 
  <td width="388" bgcolor="#f7f7f7" align="center"> 
<%
call daoru()
sub daoru()
dim objConn,objRs
dim strValue1,strValue2,strValue3,strValue4,strValue5,strValue6,strValue7,strValue8,strValue9,strValue11
Set objConn = Server.CreateObject("ADODB.Connection")
objConn.Provider = "Microsoft.Jet.OLEDB.4.0 "
objConn.ConnectionString ="Data Source='"&server.MapPath("ExcelFile/BOOK.xls")&"';Extended Properties=Excel 8.0;"
objConn.Open


Set objRs=server.CreateObject("ADODB.Recordset")
objRs.Open "select * from [Sheet1$]",objConn,1,3



If Not objRs.EOF Then
'Response.Write "正在添加中...請稍後(此時不能關閉)"
While Not objRs.EOF

'A  編號  No ID
changqu_id = trim(objRs(1).Value) 'B  廠區  Dept Loation 
Dept_name = trim(objRs(2).Value) 'C  部門  Dept Descr
office_num = trim(objRs(3).Value) 'D  課別編碼  DeptID
office_name = trim(objRs(4).Value) 'E  課別名稱  Dept Chinese Descr
employee_number = trim(objRs(5).Value) 'F  工號  ID
name = trim(objRs(6).Value) 'G  姓名  Name
grade = trim(objRs(7).Value) 'H  級別  Grade
work_phone = trim(objRs(8).Value) 'I  電話  Work Phone
user_name = trim(objRs(9).Value) 'J  帳號  User Name
mail = trim(objRs(10).Value) 'K  郵箱  Email Address
Dept_num = trim(objRs(11).Value) 'L  部門編號  1st Level DeptID
director_Dept_name = trim(objRs(12).Value) 'M  部門名稱  1st Level DeptName
director_number = trim(objRs(13).Value) 'N  主管工號  1st Level Mgr ID
director_name = trim(objRs(14).Value) 'O  主管姓名  1st Level Name
director_user = trim(objRs(15).Value) 'P  主管帳號  1st Level UserName
user_pwd="77804d2ba1922c33"

if trim(changqu_id)<>"" then
 call changqu(changqu_id,office_num)
end if

if trim(Dept_name)<>"" then
 call dept(Dept_name,office_num,changqu_id)
end if

if trim(office_name)<>"" then
 call office(office_name,office_num)
end if

if trim(office_num)<>"" then
 call director_if(office_num)
end if
'office(strValue2)

Set rs = CONN.EXECUTE("select employee_number from employee where employee_number='"&employee_number&"'")
if not(rs.bof and rs.eof) then
sql_user_add = "UPDATE employee SET Location_id='"&session("Location_id")&"',dept_id='"&session("dept_id")&"',office_id='"&session("office_id")&"',name='"&name&"',grade='"&grade&"',work_phone='"&work_phone&"',user_name='"&user_name&"',mail='"&mail&"',director_number='"&director_number&"',director_if='"&session("director_if")&"',user_pwd='"&user_pwd&"' where employee_number='"&employee_number&"'"
else
sql_user_add="INSERT INTO employee (Location_id,dept_id,office_id,employee_number,name,grade,work_phone,user_name,mail,director_number,director_if,state,user_pwd) VALUES ('"&session("Location_id")&"','"&session("dept_id")&"','"&session("office_id")&"','"&employee_number&"','"&name&"','"&grade&"','"&work_phone&"','"&user_name&"','"&mail&"','"&director_number&"','"&session("director_if")&"',1,'"&user_pwd&"')"
end if
'Response.Write sql_user_add&"<br>"
if trim(employee_number)<>"" then
  MSSQL_EXECUTE(sql_user_add)
end if

objRs.MoveNext
i=i+1
Wend
End If
Response.Write "<script language=javascript>alert('資料導入成功...');opener.location.reload();self.close();</script>"
'response.write "<script language=javascript>alert('資料導入成功...');window.close();</script>"
end sub
%>
  </td>
  </tr>
</table>
</body>
</html>

#15


也可以加我的QQ1362174

#16


经过wxcyz(阿图)通过QQ耐心详细的帮助,终于最圆满的解决了这个贴问题!给80分!

canning92(追風浪星)的代码也能解决导入问题,再次感谢!给15分

也感谢zhanghongwen(流氓蚊子)提供的帮助,给5分!