ASP实现Excel导入Access数据库

 

导入方式有很多，思路有两种：

1、用户直接打开本地Excel文件，通过程序直接导入Access数据库;

2、用户打开本地Excel文件，通过程序上传至固定文件夹，然后通过程序将数据导入Access数据库

两种方式相比较，方法2比方法1更为适用。

一开始，使用第一种方法，本机测试通过，但是通过网络访问则会出现错误提示：'80040e37'，并提示找不到指定的文件。后来才发现，要使用此方法实现数据导入，必须设定服务器的控制权限为完全控制，还需要将Excel文件所在的盘符设置默认共享~ 这样看来这种方法不是很可取，对服务器安全性有影响。

如果用第二种方式实现，没有上述的权限限制，只需要结合文件上传就能够避免'80040e37'错误产生。

先附上方式一所用函数：

'-------------------------------------------------------------------------------------
'Exce导入到SQL
'参数：FileExce excel表格路径； sheet: excel表格名，默认为sheet1
'
'-------------------------------------------------------------------------------------
Function ExceToSql(FilePath,sheet,pro_type)
Dim PatnNow
if sheet="" then sheet="sheet1"
PatnNow=FilePath
    'PatnNow="uploadfile/ultrawebgrid1.xls"

'=====================ASP读取EXCEL注事项===========================
'i)将Excel97或Excel2000生成的XLS文件（book）看成一个数据库，其中的每一个工作表(sheet)看成数据库表
'ii)ADO假设Excel中的第一行为字段名.所以你定义的范围中必须要包括第一行的内容
'iii)Excel中的行标题（即字段名）不能够包含数字. Excel的驱动在遇到这种问题时就会出错的。例如你的行标题名为“F1”
'iiii)如果你的Excel电子表格中某一列同时包含了文本和数字的话,那么Excel的ODBC驱动将不能够正常处理这一行的数据类型,你必须要保证该列的数据类型一致
'===========================================================

Dim ConnXls,Driver,DBPath,Rs
Dim tmpName,table,tmpItem

table="数据表" '表名
'tmpItem=array("a1","a2","a3")
tmpItem="a1,a2,a3"
'tmpItem=split(tmpItem,",")
tmpName=array("a1","a2","a3") 'excel表头

' 建立Connection对象
Set ConnXls = Server.CreateObject("ADODB.Connection")
Driver = "Driver={Microsoft Excel Driver (*.xls)};"
'DBPath = "DBQ=" & Server.MapPath(PatnNow)
DBPath = "DBQ=" & PatnNow
'调用Open 方法打开数据库
ConnXls.Open Driver & DBPath

'DSN连接方式
'ConnXls.Open "Dsn=test"
Sql="Select * From ["&sheet&"$] " '注意 表名一定要以下边这种格试 "[表名$]" 书写
Set Rs=ConnXls.Execute(Sql)
response.write "<br>"
    IF Rs.Eof And Rs.Bof Then
         MessageBox("系统提示：没有找到所需数据，请确定后重新操作!!")
          GoBack() ' 返回前一页的小函数 ，不贴出来了
    Else
         Do While Not Rs.EOF
          value1=""
          for i=0 to ubound(tmpName)
              value1=value1&","&"'"&rs(tmpName(i))&"'"
          next
          value1=right(value1,len(value1)-1)&","&pro_type&",'cn'"
          if left(value1,1)<>"'" then value1="'"&value1

          '将数据写入数据库
          Set rstmp= Server.CreateObject("Adodb.RecordSet")
          rstmp.Open "SELECT count(*) FROM "&table &" Where [关键字段] ='"& 关键字 &"'",dbConn,1,1
          if rstmp.fields(0)=0 then 
              sql = "insert into "&table &" (" & tmpItem & ") VALUES (" & value1& ")"
              sql = replace(replace(sql,",'',",",null,"),",'',",",null,")
              dbConn.Execute sql
          else
             sql="UPDATE "&table&" SET "
             tmpItem_arr=split(tmpItem,",")
              value1_Arr=split(value1,",")
              for i=0 to ubound(tmpItem_arr)
                   if value1_Arr(i)="" then
                        sql = sql & tmpItem_arr(i) & "=null"
                   else
                        sql = sql & tmpItem_arr(i) & "=" & value1_Arr(i)
                   end if
                   if i <> ubound(tmpItem_arr) then sql=sql & "," else sql=sql & " where [关键字段]='" & 关键字 & "'"
            next
          dbConn.Execute sql
         end if
Rs.MoveNext
Loop
End IF

Rs.Close
Set Rs=nothing

ConnXls.Close
Set ConnXls=Nothing

MessageBox("系统提示：批量录入成功!!")
GoBack()   '返回前一页的小函数 ，不贴出来了
  
end function