28,405
社区成员
发帖
与我相关
我的任务
分享（excel表导入到sqlserver库中）本地机运行正常，修改ip后远程提交数据错误 在线等 谢谢！
<%
'On Error Resume Next
'导入Excel电子表格数据到SQL Sever数据库
Function Open_Conn(SqlDatabaseName,SqlPassword,SqlUsername,SqlLocalName,SqlConn)
'创建数据库连接对象并打开数据库连接
Dim ConnStr
'SQL Server数据库连接参数：数据库名、用户密码、用户名、连接名（本地用local，外地用IP）
ConnStr = "Provider=Sqloledb; User ID=" & SqlUsername & "; Password=" & SqlPassword & "; Initial Catalog = " & SqlDatabaseName & "; Data Source=" & SqlLocalName & ";"
Set SqlConn = Server.CreateObject("ADODB.Connection")
SqlConn.Open ConnStr
If Err Then
Err.Clear
Set SqlConn = Nothing
Response.Write "数据连接错误!"
Response.End
End If
End Function
Function Close_Conn(SqlConn)
'关闭数据库连接并清除数据库连接对象
If IsObject(SqlConn) Then
SqlConn.Close
Set SqlConn = Nothing
End If
End Function
Call Open_Conn("saleTool","7060817","sa","(local)",SqlConn) '打开SQL Server数据库连接
%>
<html>
<head>
<title>导入Excel电子表格数据到SQL Sever数据库</title>
<body bgcolor="#ACD9AF">
<font color=blue>导出过程中不要刷新頁面！</font><br>
<%
If Right(Trim(Request("File")),3) = "xls" Then
Response.Write "<font color=red>您所导出的Excel文件是："&Trim(Request("File"))&"</font><br>"
End If
'=====================ASP读取EXCEL注事项=====================================
'i)将Excel97或Excel2000生成的XLS文件（book）看成一个数据库，其中的每一个工作表(sheet)看成数据库表
'ii)ADO假设Excel中的第一行为字段名.所以你定义的范围中必须要包括第一行的内容
'iii)Excel中的行标题（即字段名）不能够包含数字. Excel的驱动在遇到这种问题时就会出错的。例如你的行标题名为“F1”
'iiii)如果你的Excel电子表格中某一列同时包含了文本和数字的话,那么Excel的ODBC驱动将不能够正常, 处理这一行的数据类型，你必须要保证该列的数据类型一致
'============================================================================
If Trim(Request("File")) = "" Then
Response.Write "<font color=red>对不起，请选择需要导出的Excel文件！</font>"
Response.End
ElseIf Right(Trim(Request("File")),3) <> "xls" Then
Response.Write "<font color=red>对不起，请确定您要导出的是Excel文件！</font>"
Response.End
Else
'列出所选择的Excel文件中的所有工作表
Dim ExeclFile,objExcelApp,objExcelBook
ExeclFile = Trim(Request("File"))
Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Quit
objExcelApp.DisplayAlerts = False '不显示警告
objExcelApp.Application.Visible = False '不显示界面
objExcelApp.WorkBooks.Open(ExeclFile)
set objExcelBook = objExcelApp.ActiveWorkBook
reDim arrSheets(objExcelBook.Sheets.Count)
For i=1 to objExcelBook.Sheets.Count
arrSheets(i) = objExcelBook.Sheets(i).Name
' Response.Write arrSheets(i)
Next
objExcelApp.Quit
Set objExeclApp = Nothing
'列出所选择的Excel文件中的所有工作表
End If
Dim Conn,Driver,DBPath,Rs,SqlInsert,SqlDelete
'建立Connection对象
Set Conn = Server.CreateObject("ADODB.Connection")
Driver = "Driver={Microsoft Excel Driver (*.xls)};"
'DBPath = "DBQ=" & Server.MapPath( "HRB.xls" )
DBPath = "DBQ=" & Trim(Request("File"))
'调用Open 方法打开数据库
Conn.Open Driver & DBPath
'DSN连接方式
'Conn.Open "Dsn=test"
'注意 表名一定要以下边这种格式 "[表名$]" 书写
For i = 1 To UBound(arrSheets)'开始循环所有工作表
Sql = "SELECT * FROM ["& arrSheets(i) &"$] "
Set Rs = Conn.Execute(Sql)
If Rs.Eof And Rs.Bof Then
Response.write "没有找到您需要的数据!!<br>"
Else
'Response.Write "<font color=blue>工作表:</font><font color=green>"&arrSheets(i)&"</font><br>"
Do While Not Rs.Eof
'以下是根据用户选择的表进行相应的操作
If Trim(Request("Table")) = "用户台帐" then
SqlInsert = "Insert Into userAcco(phoneno,clientname,datenet,nettype,unit,person,phonetype,amount,firstpay,timelong,datasource,link,address,remark) Values ('"&Trim(Rs(0))&"','"&Trim(Rs(1))&"','"&Trim(Rs(2))&"','"&Trim(Rs(3))&"','"&Trim(Rs(4))&"','"&Trim(Rs(5))&"','"&Trim(Rs(6))&"','"&Trim(Rs(7))&"','"&Trim(Rs(8))&"',"&Trim(Rs(9))&",'"&Trim(Rs(10))&"','"&Trim(Rs(11))&"','"&Trim(Rs(12))&"','"&Trim(Rs(13))&"')"
ElseIf Trim(Request("Table")) = "零次户" then
SqlInsert = "Insert Into zeroAcco(dateCreate,phoneno,clientname,datenet,bgroup,taocan,datasource,servicestate,clienttype,remark)Values('"&Trim(Rs(0))&"','"&Trim(Rs(1))&"','"&Trim(Rs(2))&"','"&Trim(Rs(3))&"','"&Trim(Rs(4))&"','"&Trim(Rs(5))&"','"&Trim(Rs(6))&"','"&Trim(Rs(7))&"','"&Trim(Rs(8))&"','"&Trim(Rs(9))&"')"
ElseIf Trim(Request("Table")) = "欠费" then
SqlInsert = "Insert Into lendMoney(phoneno,clientname,datefee,bgroup,taocan,datasource,servicestate,amount,datepay,remark)Values('"&Trim(Rs(0))&"','"&Trim(Rs(1))&"','"&Trim(Rs(2))&"','"&Trim(Rs(3))&"','"&Trim(Rs(4))&"','"&Trim(Rs(5))&"','"&Trim(Rs(6))&"','"&Trim(Rs(7))&"','"&Trim(Rs(8))&"','"&Trim(Rs(9))&"')"
Else
SqlInsert = "Insert Into zj(phoneno,clientname,datenet,nettype,unit,person,phonetype,amount,firstpay,timelong,datasource,datezj,remark)Values('"&Trim(Rs(0))&"','"&Trim(Rs(1))&"','"&Trim(Rs(2))&"','"&Trim(Rs(3))&"','"&Trim(Rs(4))&"','"&Trim(Rs(5))&"','"&Trim(Rs(6))&"','"&Trim(Rs(7))&"','"&Trim(Rs(8))&"','"&Trim(Rs(9))&"','"&Trim(Rs(10))&"','"&Trim(Rs(11))&"','"&Trim(Rs(12))&"')"
End if
'此处插入的值根据实际数据库结构进行调整
SqlConn.Execute(SqlInsert)'插入Excel表格里所有东东
Rs.MoveNext
Loop
Response.Write "<font color=red>恭喜，成功导出Excel文件中工作表[</font><font color=blue>"&arrSheets(i)&"</font><font color=red>]的数据到SQL Server數據表[<font color=blue>"&Trim(Request("Table"))&"</font>]中！^_^</font><br>"
End If
Rs.Close
Set Rs = Nothing
Next'循环所有工作表結束
Call Close_Conn(Conn) '关闭Excel数据库连接
Call Close_Conn(SqlConn) '关闭SQL Server数据库连接 %>
</body>
</html>
错误为：
Microsoft VBScript 运行时错误 错误 '800a0046'
没有权限: 'CreateObject'
'On Error Resume Next
'导入Excel电子表格数据到SQL Sever数据库
Function Open_Conn(SqlDatabaseName,SqlPassword,SqlUsername,SqlLocalName,SqlConn)
'创建数据库连接对象并打开数据库连接
Dim ConnStr
'SQL Server数据库连接参数：数据库名、用户密码、用户名、连接名（本地用local，外地用IP）
ConnStr = "Provider=Sqloledb; User ID=" & SqlUsername & "; Password=" & SqlPassword & "; Initial Catalog = " & SqlDatabaseName & "; Data Source=" & SqlLocalName & ";"
Set SqlConn = Server.CreateObject("ADODB.Connection")
SqlConn.Open ConnStr
If Err Then
Err.Clear
Set SqlConn = Nothing
Response.Write "数据连接错误!"
Response.End
End If
End Function
Function Close_Conn(SqlConn)
'关闭数据库连接并清除数据库连接对象
If IsObject(SqlConn) Then
SqlConn.Close
Set SqlConn = Nothing
End If
End Function
Call Open_Conn("saleTool","7060817","sa","(local)",SqlConn) '打开SQL Server数据库连接
%>
<html>
<head>
<title>导入Excel电子表格数据到SQL Sever数据库</title>
<body bgcolor="#ACD9AF">
<font color=blue>导出过程中不要刷新頁面！</font><br>
<%
If Right(Trim(Request("File")),3) = "xls" Then
Response.Write "<font color=red>您所导出的Excel文件是："&Trim(Request("File"))&"</font><br>"
End If
'=====================ASP读取EXCEL注事项=====================================
'i)将Excel97或Excel2000生成的XLS文件（book）看成一个数据库，其中的每一个工作表(sheet)看成数据库表
'ii)ADO假设Excel中的第一行为字段名.所以你定义的范围中必须要包括第一行的内容
'iii)Excel中的行标题（即字段名）不能够包含数字. Excel的驱动在遇到这种问题时就会出错的。例如你的行标题名为“F1”
'iiii)如果你的Excel电子表格中某一列同时包含了文本和数字的话,那么Excel的ODBC驱动将不能够正常, 处理这一行的数据类型，你必须要保证该列的数据类型一致
'============================================================================
If Trim(Request("File")) = "" Then
Response.Write "<font color=red>对不起，请选择需要导出的Excel文件！</font>"
Response.End
ElseIf Right(Trim(Request("File")),3) <> "xls" Then
Response.Write "<font color=red>对不起，请确定您要导出的是Excel文件！</font>"
Response.End
Else
'列出所选择的Excel文件中的所有工作表
Dim ExeclFile,objExcelApp,objExcelBook
ExeclFile = Trim(Request("File"))
Set objExcelApp = CreateObject("Excel.Application")
objExcelApp.Quit
objExcelApp.DisplayAlerts = False '不显示警告
objExcelApp.Application.Visible = False '不显示界面
objExcelApp.WorkBooks.Open(ExeclFile)
set objExcelBook = objExcelApp.ActiveWorkBook
reDim arrSheets(objExcelBook.Sheets.Count)
For i=1 to objExcelBook.Sheets.Count
arrSheets(i) = objExcelBook.Sheets(i).Name
' Response.Write arrSheets(i)
Next
objExcelApp.Quit
Set objExeclApp = Nothing
'列出所选择的Excel文件中的所有工作表
End If
Dim Conn,Driver,DBPath,Rs,SqlInsert,SqlDelete
'建立Connection对象
Set Conn = Server.CreateObject("ADODB.Connection")
Driver = "Driver={Microsoft Excel Driver (*.xls)};"
'DBPath = "DBQ=" & Server.MapPath( "HRB.xls" )
DBPath = "DBQ=" & Trim(Request("File"))
'调用Open 方法打开数据库
Conn.Open Driver & DBPath
'DSN连接方式
'Conn.Open "Dsn=test"
'注意 表名一定要以下边这种格式 "[表名$]" 书写
For i = 1 To UBound(arrSheets)'开始循环所有工作表
Sql = "SELECT * FROM ["& arrSheets(i) &"$] "
Set Rs = Conn.Execute(Sql)
If Rs.Eof And Rs.Bof Then
Response.write "没有找到您需要的数据!!<br>"
Else
'Response.Write "<font color=blue>工作表:</font><font color=green>"&arrSheets(i)&"</font><br>"
Do While Not Rs.Eof
'以下是根据用户选择的表进行相应的操作
If Trim(Request("Table")) = "用户台帐" then
SqlInsert = "Insert Into userAcco(phoneno,clientname,datenet,nettype,unit,person,phonetype,amount,firstpay,timelong,datasource,link,address,remark) Values ('"&Trim(Rs(0))&"','"&Trim(Rs(1))&"','"&Trim(Rs(2))&"','"&Trim(Rs(3))&"','"&Trim(Rs(4))&"','"&Trim(Rs(5))&"','"&Trim(Rs(6))&"','"&Trim(Rs(7))&"','"&Trim(Rs(8))&"',"&Trim(Rs(9))&",'"&Trim(Rs(10))&"','"&Trim(Rs(11))&"','"&Trim(Rs(12))&"','"&Trim(Rs(13))&"')"
ElseIf Trim(Request("Table")) = "零次户" then
SqlInsert = "Insert Into zeroAcco(dateCreate,phoneno,clientname,datenet,bgroup,taocan,datasource,servicestate,clienttype,remark)Values('"&Trim(Rs(0))&"','"&Trim(Rs(1))&"','"&Trim(Rs(2))&"','"&Trim(Rs(3))&"','"&Trim(Rs(4))&"','"&Trim(Rs(5))&"','"&Trim(Rs(6))&"','"&Trim(Rs(7))&"','"&Trim(Rs(8))&"','"&Trim(Rs(9))&"')"
ElseIf Trim(Request("Table")) = "欠费" then
SqlInsert = "Insert Into lendMoney(phoneno,clientname,datefee,bgroup,taocan,datasource,servicestate,amount,datepay,remark)Values('"&Trim(Rs(0))&"','"&Trim(Rs(1))&"','"&Trim(Rs(2))&"','"&Trim(Rs(3))&"','"&Trim(Rs(4))&"','"&Trim(Rs(5))&"','"&Trim(Rs(6))&"','"&Trim(Rs(7))&"','"&Trim(Rs(8))&"','"&Trim(Rs(9))&"')"
Else
SqlInsert = "Insert Into zj(phoneno,clientname,datenet,nettype,unit,person,phonetype,amount,firstpay,timelong,datasource,datezj,remark)Values('"&Trim(Rs(0))&"','"&Trim(Rs(1))&"','"&Trim(Rs(2))&"','"&Trim(Rs(3))&"','"&Trim(Rs(4))&"','"&Trim(Rs(5))&"','"&Trim(Rs(6))&"','"&Trim(Rs(7))&"','"&Trim(Rs(8))&"','"&Trim(Rs(9))&"','"&Trim(Rs(10))&"','"&Trim(Rs(11))&"','"&Trim(Rs(12))&"')"
End if
'此处插入的值根据实际数据库结构进行调整
SqlConn.Execute(SqlInsert)'插入Excel表格里所有东东
Rs.MoveNext
Loop
Response.Write "<font color=red>恭喜，成功导出Excel文件中工作表[</font><font color=blue>"&arrSheets(i)&"</font><font color=red>]的数据到SQL Server數據表[<font color=blue>"&Trim(Request("Table"))&"</font>]中！^_^</font><br>"
End If
Rs.Close
Set Rs = Nothing
Next'循环所有工作表結束
Call Close_Conn(Conn) '关闭Excel数据库连接
Call Close_Conn(SqlConn) '关闭SQL Server数据库连接 %>
</body>
</html>
错误为：
Microsoft VBScript 运行时错误 错误 '800a0046'
没有权限: 'CreateObject'
...全文
请发表友善的回复…
发表回复
wzhiyuan 2005-07-14
- 打赏
- 举报
mark.
同意walkingpoison(walkingpoison)
同意walkingpoison(walkingpoison)
walkingpoison 2005-07-14
- 打赏
- 举报
看来你并不是很清楚求助之道：
1.一开始贴出了大量的代码，没人愿意把你所有的代码一行一行看过去的，应当选出关键的部分贴出来。
2.“我把这个程序在那个本地机上试一下也不行 求助！”--什么程序？是我贴的代码吗？也不行是什么意思？有什么出错信息？什么都不告诉我，让我怎么帮你？“求助”两个字很简单，但是要别人怎么帮助你？难道帮你把完整的代码全都写出来？
建议你看看下面这篇文章：http://www.abbs.com.cn/bbs/post/view?bid=49&id=5824450&sty=1&tpg=1&age=0
1.一开始贴出了大量的代码，没人愿意把你所有的代码一行一行看过去的，应当选出关键的部分贴出来。
2.“我把这个程序在那个本地机上试一下也不行 求助！”--什么程序？是我贴的代码吗？也不行是什么意思？有什么出错信息？什么都不告诉我，让我怎么帮你？“求助”两个字很简单，但是要别人怎么帮助你？难道帮你把完整的代码全都写出来？
建议你看看下面这篇文章：http://www.abbs.com.cn/bbs/post/view?bid=49&id=5824450&sty=1&tpg=1&age=0
wjwsnow 2005-07-13
- 打赏
- 举报
net_lover(孟子E章) 先谢谢你
我按那样做了还是不行 有一点想不明白在我机子上什么都没配置 运行就正常 但是一道服务器那里就不行了？！
我按那样做了还是不行 有一点想不明白在我机子上什么都没配置 运行就正常 但是一道服务器那里就不行了？！
孟子E章 2005-07-13
- 打赏
- 举报
参考
http://support.microsoft.com/default.aspx?scid=kb;zh-cn;288367
运行dcomcnfg
http://support.microsoft.com/default.aspx?scid=kb;zh-cn;288367
运行dcomcnfg
wjwsnow 2005-07-13
- 打赏
- 举报
老兄 我把这个程序在那个本地机上试一下也不行 求助！
walkingpoison 2005-07-13
- 打赏
- 举报
还有，你可以试一下owc，这个应该不会出问题
walkingpoison 2005-07-13
- 打赏
- 举报
服务器端使用Excel对象总是有问题，我曾经试过很久，都是不稳定，有时候好有时候出问题。dcom的配置之类的都做过很多次了，一直解决不了不稳定的问题，所以我认为是微软的bug。
解决的方法是有的，那就是不用Excel对象。不用Excel对象也是可以获得每一个Sheet名的，使用connection的OpenSchema方法。
Set conn = New ADODB.Connection
conn.Open "driver={Microsoft Excel Driver (*.xls)};DBQ=" & strFileName
Set rsExcelSheet = conn.OpenSchema(adSchemaTables)
获得表名可以用rsExcelSheet(2)，循环取得所有表名。这里是vb代码，所以用了new关键字，注意与asp中不同。如果在asp中使用，还要定义一下adSchemaTables = 20
解决的方法是有的，那就是不用Excel对象。不用Excel对象也是可以获得每一个Sheet名的，使用connection的OpenSchema方法。
Set conn = New ADODB.Connection
conn.Open "driver={Microsoft Excel Driver (*.xls)};DBQ=" & strFileName
Set rsExcelSheet = conn.OpenSchema(adSchemaTables)
获得表名可以用rsExcelSheet(2)，循环取得所有表名。这里是vb代码，所以用了new关键字，注意与asp中不同。如果在asp中使用，还要定义一下adSchemaTables = 20
