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