电子表格 文件是 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
%>
给分吧.
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运行正常,数据库所在目录权限支持写入...
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>"
你难道不会自己看一下代码吗?
这是先在前一个页面加一上文件选择框选择文件之后再导.不要太依靠别人,自己也要学着改呀.
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:密码
希望能写全面代码给我,包括提交页面,还有代码中的数据库路径、表名!
感激不尽!先行谢谢了!
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
%>
提供一下我修改的你的源码后,做的测试文档,并通过验证了:
<%
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,必要要做提交页面的!
最后,你能加个提交页面吗?因为客户需要调用本地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>
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分!
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
%>
给分吧.
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运行正常,数据库所在目录权限支持写入...
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>"
你难道不会自己看一下代码吗?
这是先在前一个页面加一上文件选择框选择文件之后再导.不要太依靠别人,自己也要学着改呀.
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:密码
希望能写全面代码给我,包括提交页面,还有代码中的数据库路径、表名!
感激不尽!先行谢谢了!
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
%>
提供一下我修改的你的源码后,做的测试文档,并通过验证了:
<%
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,必要要做提交页面的!
最后,你能加个提交页面吗?因为客户需要调用本地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>
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分!
canning92(追風浪星)的代码也能解决导入问题,再次感谢!给15分
也感谢zhanghongwen(流氓蚊子)提供的帮助,给5分!