客戶要求：后台的產品那里有個按分類或按ID挑選或者全部的方式，批量選擇產品，然后導出成excel(.xls)文件，並且這個圖片當中的除標題行外，每行的第一（或第二個）單元格里邊是一個產品的小圖縮略圖。客戶對這excel文件進行編輯，然后再通過excel文件導入進行產品批量更新。
流程當中涉及到的兩大部分為：1.從database導出到Excel 2.從Excel導入到database
在網上網羅了N多文章，最后決定用Excel.Application這個組件來完成！問題：
1.服務器安裝了Excel.Application組件（這種情況，不必要求客戶端已經安裝了Excel)
2.服務器無安裝Excel.Application組件 (這種情況，必須要求客戶端已經安裝了Excel）
3.如果服務器未安裝Excel.Application組件,客戶端也沒有安裝Excel組件，這時如何辦？
折衷之后，去除了第三種情況（嚴格要求客戶必須要安裝Excel，否則不能進行該導出操作！）
第一部分代碼是關於服務器端Excel.Application能否處理的問題，如果不能處理，則交由客戶端Excel.Application去處理，具體代碼：
1 On Error Resume Next
2 Set ExcelApp =CreateObject("Excel.Application")
3 If Err Then
4 Response.Write "<div style=""margin-left:30px;""><font color=red>"&Err.Description & "<br/>調用Excel組件出錯(服務器端不支持:服務器未安裝EXCEL),一般情況下:<br/<br/><font color=black>對於虛擬空間依賴於其服務器,不過一般該虛擬空間的服務器不會支持,<br/>對於有獨立服務器的情況,則可以在服務器內安裝Excel組件以使其支持!"&"</font></font></div>" &"<br/>"&vbNewline
5 Response.Write "<br/>"
6 Err.Clear
7 Response.Write "<div style=""margin-left:30px;"">雖然當前操作失敗,如果您的客戶機(本地電腦)如果裝有Excel(2003),則可以嘗試以下操作:<br/><br/><a href=""exportproducts_client.asp?time="&now&"&by="&Request.QueryString("by")&"&fid="&Request.Form("fid")&"&selectfields="&Request.Form("selectfields")&"&picWidth="&Request.Form("picWidth")&"&picHeight="&Request.Form("picHeight")&"&ck="&Request.Form("ck")&""&""" target=""_blank""><font color=blue>嘗試:使用客戶端EXCEL模式生成</font></a><br/><font color=""#CCCCCC"">注:該操作將會分幾步完成該導出操作:<br/>1.先保存一個.html網頁到您的電腦<br/>2.您打開該保存的網頁繼續導出操作!<br/>3.將會在客戶端打開一個Excel文件,然后你也保存該Excel文件到您的電腦<br/>4.直接在你電腦上操作該只在的Excel文件<br/>5.對已經編輯好的Excel文件,可以到這里進行下一步(即""導入"")操作!</font></div>"&"<br/>"&vbNewline
8
9 Response.Write "<br/><br/><div style=""margin-left:30px;""><hr style=""font-weight:bolder;height:5px;"" color=""#CCCCCC""></div>"&"<br/>"&vbNewline
10 Response.Write "<div style=""margin-left:30px;"">其它后綴操作:</div>"&"<br/>"&vbNewline
11 Response.Write "<div style=""margin-left:30px;""><a href=""uploadproduct.asp?action=uploadproductsforupdate"" target=""_self""><font color=blue>上一步</font></a><br/><font color=""#CCCCCC"">(注:合於需要重新選擇導出條件的情形)</font></div>"&"<br/>"&vbNewline
12
13 Response.Write "<div style=""margin-left:30px;""><a href=""uploadproduct.asp?action=uploadproductsforupdate&step=step3"" target=""_self""><font color=blue>下一步</font></a><br/><font color=""#CCCCCC"">(注:適合於需要導入之前編輯的Excel數據的情形)</font></div>"&"<br/>"&vbNewline
14
15 Response.Write ""
16 Response.End()
17 Else
18 Response.Write Now & "---服務器端開始調用Excel組件...."
19 Response.Flush()
20 End If
以代碼是針對服務器不支持Excel.Application時的友好界面提示，之后客戶可以轉入客戶端的Excel.Application處理。
下面的代碼是假定服務器端已經支持Excel.Application,則處理的代碼為：
ExcelApp.Application.Visible = True
Set ExcelBook = ExcelApp.Workbooks.Add
Dim arrTitle
Dim arrField
Dim arrI
arrTitle = Split("ID,商品圖片,商品編號,商品名稱,商品短名稱," & _
"商品介紹,商品簡述,單位,商品積分,商品排序," & _
"重量,市場價格,會員價,是否新品,是否特價," & _
"是否熱賣,是否庫存警告,警告數量,產品發布,是否實體商品," & _
"是否推薦,商品關鍵字,關鍵字描述,庫存",",")
arrField = Split("ID,p_sphoto,P_pid,p_name,P_shortName," & _
"P_Content,P_ShortContent,P_volumn,P_score,P_ordernums," & _
"P_weight,P_marketprice,P_memberprice,P_newflag,P_Fee," & _
"P_hot,P_Ifalarm,P_Alarmnum,P_publicate,P_Truegood," & _
"P_Recommend,P_keyword,P_Description,p_stock",",")
' 第一行為標題行,設置標題數據
For arrI = 0 To Ubound(arrTitle)
ExcelBook.WorkSheets(1).cells(1,arrI+1).value = ""&arrTitle(arrI)
Next
' 從第二行開始添加數據
Dim iRow : iRow = 2
Call conndb()
set rs=server.createobject("adodb.recordset")
' 導出的類別條件
Dim whereStr
Dim whereType : whereType = Trim(Request.QueryString("by"))
Select Case whereType
Case "","classid"
If Request.Form("fid") <> "0|0" Then
dim s_fid
s_fid=trim(getSubClass("web_proclass",Split(Request.Form("fid"),"|")(0)))
if s_fid="" or s_fid="," then
s_fid = 0
end if
whereStr = " Where P_ClassID in("&s_fid&")"
Else
whereStr = " Where 1=1"
End If
Case "id","ids"
whereStr = " Where ID IN("&Request.Form("ck")&")"
End Select
'Response.Write whereStr : Response.End()
' 導出的字段設置
Dim selectfields
If Request.Form("selectfields")<> "" Then
selectfields = Trim(Request.Form("selectfields"))
Else
selectfields= Join(arrField,",")
End If
'Response.Write selectfields : Response.End()
sql = "Select " & selectfields & " From web_product "& whereStr & " Order by ID ASC"
'Response.Write sql : Response.End()
rs.open sql,conn,1,1
If Err Then
Response.Write "<font color=red>數據庫連接出錯"&"</font>"
Err.Clear
End If
Dim ColumnWidthPx
ColumnWidthPx = ExcelBook.WorkSheets(1).Range("A1").Width/ExcelBook.WorkSheets(1).Columns(1).ColumnWidth
Dim picWidth,picHeight
picWidth = Clng("0"&Request.Form("picWidth"))
if picWidth = 0 Then picWidth = 100
picHeight = Clng("0"&Request.Form("picHeight"))
if picHeight = 0 Then picHeight = 80
selectfieldsArr = Split(Trim(Replace(selectfields, " ","")),",")
Dim iPicCol
'iPicCol = 2 ''對應圖片當中的第幾個字段(從1開始)
For arrI = 0 To Ubound(arrTitle)
If arrTitle(arrI) & "" = "商品圖片" Then
iPicCol = arrI + 1
Exit For
End If
Next
' 當不進行內容或簡述的更改時，將其導出為空嗎？
Dim blankContent : blankContent = true
' 對應內容，簡述大文本資料的單元格的序號(從1開始)
Dim iContentCol
'iContentCol = ",6,7,"
iContentCol = ","
For arrI = 0 To Ubound(arrTitle)
If arrTitle(arrI) & "" = "商品介紹" Or arrTitle(arrI) & "" = "商品簡述" Then
iContentCol = iContentCol & (arrI + 1) & ","
End If
Next
''需要當成字符而非數字的單元格序號
Dim numStrArr
numStrArr = Split("3,4,5,6,7,8",",")
For strI = 0 To Ubound(numStrArr)
'ExcelBook.WorkSheets(1).Columns(numStrArr(strI)).NumberFormatLocal="@" '有誤
Next
' 循環按條件讀取到的所有產品
do while not rs.eof
'ExcelBook.WorkSheets(1).Rows(iRow).RowHeight = 50
Dim iCol
For iCol = 1 To Ubound(selectfieldsArr)
Dim colType,colValue
colType = rs(iCol-1).Type
colValue = rs(iCol-1).Value
If isNull(colValue) Then
colValue = Empty
End If
If Not iCol = iPicCol Then ''處理普通字段,內容字段
If blankContent = True And (InStr(iContentCol,","&iCol&",") > 0) Then
ExcelBook.WorkSheets(1).cells(iRow,iCol).value = "暫無內容"
ElseIf blankContent = False And (InStr(iContentCol,","&iCol&",") > 0) Then
ExcelBook.WorkSheets(1).cells(iRow,iCol).value = Replace(Replace(colValue,"<br/>",chr(10)),"<br>",chr(10))
Else
ExcelBook.WorkSheets(1).cells(iRow,iCol).value = colValue
End If
Else ''處理圖片字段
With ExcelBook.WorkSheets(1).Cells(iRow,iCol)
.Select
.columnwidth = picWidth\ColumnWidthPx
.RowHeight = picHeight
End With
Dim picUrl
'picUrl = "http://www.baidu.com/img/baidu_jgylogo3.gif" '' 遠程圖片測試(失敗)
'picUrl = Replace("http://localhost:8067/images/ver_01.jpg","/","\\) '' 遠程圖片測試(未測試)
'picUrl = "F:\databaseexcel\1.jpg" ''本地圖片測試(成功)
'picUrl = Server.MapPath("/"&rs("P_Pphoto")) '' 本地圖片測試(成功)
picUrl = Server.MapPath("/"&colValue) '' 本地圖片測試(成功)
PicUrl = Replace(picUrl,"/","\") '解決不能取得類 Pictures 的 Insert 屬性
'Response.write picUrl : Response.End()
With ExcelBook.WorkSheets(1).Pictures.Insert(PicUrl)
'.Select
.Width = ExcelBook.WorkSheets(1).Cells(iRow,iCol).Width
.Height = ExcelBook.WorkSheets(1).Cells(iRow,iCol).Height
End With
End If
Next
rs.movenext
iRow = iRow + 1
If Err Then
Response.write "<font color=red>"&Err.Description & "<br/>循環讀取產品行,循環寫入工作表Rows-"&iRow&"</font>"
Err.Clear
Response.End()
End If
loop
Call CloseRC()
' 保存excel文件
Dim fileName
Dim filePath
Dim fileDownloadUrl
fileName = "excel-"&Right("00"&Year(Now),4)&"-"&Right("0"&Month(now),2)&"-"&Right("0"&Day(now),2)&"-"&Right("0"&Hour(now),2)&"-"&Right("0"&Minute(now),2)&"-"&Right("0"&Second(now),2) & ".xls"
fileDownloadUrl = "/databaseexcel/"&fileName
filePath = Server.MapPath(fileDownloadUrl)
''只在ＥＸＣＥＬ文件到服務器
Excelbook.SaveAs filePath
If Err Then
Response.Write "<font color=red>保存EXCEL文件出錯！</font>"
Err.Clear
Response.End()
End If
' 導出以后退出Excel
ExcelApp.Application.Quit
' 注銷Excel對象
Set ExcelApp = Nothing
' 跳轉到下載頁
If Not Err Then
Response.Write "<font color=red>"&Now&"</font>" & "已經生成EXCEL文件,請查看:"&filePath
Response.Flush()
Response.Write("<script>window.location.href='uploadproduct.asp?action=uploadproductsforupdate&step=step2&filename="&fileDownloadUrl&"';<"&"/script>")
Response.End()
End If
至此，服務器支持Excel組件時，已經能夠很好的完成客戶的需求。
下邊的代碼，將位於另一個文件，進行“當服務器端不支持Excel組件”時的客戶端處理：
<body onLoad="MakeExcel();">
<%
On Error Resume Next
Dim arrTitle
Dim arrField
Dim arrI
arrTitle = Split("ID,商品圖片,商品編號,商品名稱,商品短名稱," & _
"商品介紹,商品簡述,單位,商品積分,商品排序," & _
"重量,市場價格,會員價,是否新品,是否特價," & _
"是否熱賣,是否庫存警告,警告數量,產品發布,是否實體商品," & _
"是否推薦,商品關鍵字,關鍵字描述,庫存",",")
arrField = Split("ID,p_sphoto,P_pid,p_name,P_shortName," & _
"P_Content,P_ShortContent,P_volumn,P_score,P_ordernums," & _
"P_weight,P_marketprice,P_memberprice,P_newflag,P_Fee," & _
"P_hot,P_Ifalarm,P_Alarmnum,P_publicate,P_Truegood," & _
"P_Recommend,P_keyword,P_Description,p_stock",",")
' 從第二行開始添加數據
Dim iRow : iRow = 2
Call conndb()
set rs=server.createobject("adodb.recordset")
' 導出的類別條件
Dim whereStr
Dim whereType : whereType = Trim(Request.QueryString("by"))
Select Case whereType
Case "","classid"
If Request.QueryString("fid") <> "0|0" Then
dim s_fid
s_fid=trim(getSubClass("web_proclass",Split(Request.QueryString("fid"),"|")(0)))
if s_fid="" or s_fid="," then
s_fid = 0
end if
whereStr = " Where P_ClassID in("&s_fid&")"
Else
whereStr = " Where 1=1"
End If
Case "id","ids"
whereStr = " Where ID IN("&Request.QueryString("ck")&")"
End Select
' 導出的字段設置
Dim selectfields
If Request.QueryString("selectfields")<> "" Then
selectfields = Trim(Request.QueryString("selectfields"))
Else
selectfields= Join(arrField,",")
End If
sql = "Select " & selectfields & " From web_product "& whereStr & " Order by ID ASC"
rs.open sql,conn,1,1
If Err Then
Response.Write "<font color=red>數據庫連接有錯！</font>"
Err.Clear
Response.End()
End If
Dim picWidth,picHeight
picWidth = Clng("0"&Request.QueryString("picWidth"))
if picWidth = 0 Then picWidth = 100
picHeight = Clng("0"&Request.QueryString("picHeight"))
if picHeight = 0 Then picHeight = 80
selectfieldsArr = Split(Trim(Replace(selectfields, " ","")),",")
Dim iPicCol
'iPicCol = 2 ''對應圖片當中的第幾個字段(從1開始)
For arrI = 0 To Ubound(arrTitle)
If arrTitle(arrI) & "" = "商品圖片" Then
iPicCol = arrI + 1
Exit For
End If
Next
Dim blankContent : blankContent = true Or False
Dim iContentCol
'iContentCol = ",7,"
iContentCol = ","
For arrI = 0 To Ubound(arrTitle)
If arrTitle(arrI) & "" = "商品介紹" Or arrTitle(arrI) & "" = "商品簡述" Then
iContentCol = iContentCol & (arrI + 1) & ","
End If
Next
''需要當成字符而非數字的單元格序號
Dim numStrArr
numStrArr = Split("3,4,5,6,7,8",",")
%>
<script language="javascript" type="text/javascript">
//客戶端導出EXCEL
function MakeExcel() {
var i, j, n;
try {
var xls = new ActiveXObject("Excel.Application");
}
catch(e) {
//window.alert("要打印該表，您必須安裝Excel電子表格軟件，同時瀏覽器須使用\"ActiveX 控件\"，您的瀏覽器須執行控件。請點擊【幫助】了解瀏覽器設置方法！\n------------------------------------------------------------\n友情提示:如果您不使設置瀏覽器的ActiveX控件權限,您可以直接將本頁面另存到您的電腦當中,再進行執行以避免ActiveX的權限問題!!");
savehtml();
return "";
}
// 設置excel為可見
xls.visible =true;
//新建工作簿
var xlBook = xls.Workbooks.Add;
//激活當前工作表
var xlsheet = xlBook.Worksheets(1);
//設置列寬
xlsheet.Columns("C:J").ColumnWidth =20;
//設置顯示字符而不是數字
<%For strI = 0 To Ubound(numStrArr)%>
xlsheet.Columns(<%=numStrArr(strI)%>).NumberFormatLocal="@";
<%Next%>
//設置標題欄
<%For arrI = 0 To Ubound(arrTitle)%>
xlsheet.Cells(1, <%=arrI+1%>).Value = "<%=arrTitle(arrI)%>";
<%Next%>
//單元格比率
var ColumnWidthPx =xlsheet.Range("A2").Width/xlsheet.Columns(1).ColumnWidth;
//alert(ColumnWidthPx);// 6.208....
//單元格寬度,高度
var picWidth = 100;
var picHeight = 80;
//單元格ColumnWidth處理
var cellColumnWidth = picWidth/ColumnWidthPx;
//單元格數目
var cellsnumber = (<%=Ubound(arrTitle)%>+1);
try {
<%
' 循環讀取產品
do while not rs.eof
'ExcelBook.WorkSheets(1).Rows(iRow).RowHeight = 50
Dim iCol
For iCol = 1 To Ubound(selectfieldsArr)+1
Dim colType,colValue
colType = rs(iCol-1).Type
colValue = rs(iCol-1).Value
If isNull(colValue) Then
colValue = Empty
End If
If Not iCol = iPicCol Then ''處理普通字段,內容字段%>
<%If blankContent = True And (InStr(iContentCol,","&iCol&",") > 0) Then ''內容允許為白,並且對於簡介,內容等字段%>
xlsheet.Cells(<%=iRow%>, <%=iCol%>).Value = "暫無內容";
<%ElseIf blankContent = False And (InStr(iContentCol,","&iCol&",") > 0) Then%>
xlsheet.Cells(<%=iRow%>, <%=iCol%>).Value = "<%=replace(replace(colValue,"<br/>",chr(10)),"<br>",chr(10))%>"
<%Else%>
xlsheet.Cells(<%=iRow%>, <%=iCol%>).Value = "<%=colValue%>";
<%End If%>
<%Else ''處理圖片字段%>
xlsheet.Cells(<%=iRow%>, <%=iCol%>).Select();
xlsheet.Cells(<%=iRow%>, <%=iCol%>).ColumnWidth = cellColumnWidth;
xlsheet.Cells(<%=iRow%>, <%=iCol%>).RowHeight = picHeight;
var pic = xlsheet.Pictures.Insert("http:\/\/<%=Request.ServerVariables("SERVER_NAME")%>:<%=Request.ServerVariables("SERVER_PORT")%><%=Replace(WWW,"/","\/")%><%=rs("P_sphoto")%>");
pic.Width = xlsheet.Cells(<%=iRow%>, <%=iCol%>).Width;
pic.Height = xlsheet.Cells(<%=iRow%>, <%=iCol%>).Height;
<%End If
Next
rs.movenext
iRow = iRow + 1
If Err Then
Response.Write "//循環寫入工作表過程中出錯：Rows-"&iRow&""
Err.Clear
Response.End()
End If
loop
Call CloseRC()
Dim fileName
Dim filePath
Dim fileDownloadUrl
fileName = "excel-"&Right("00"&Year(Now),4)&"-"&Right("0"&Month(now),2)&"-"&Right("0"&Day(now),2)&"-"&Right("0"&Hour(now),2)&"-"&Right("0"&Minute(now),2)&"-"&Right("0"&Second(now),2) & ".xls"
fileDownloadUrl = "/databaseexcel/"&fileName
filePath = Server.MapPath(fileDownloadUrl)
%>
}catch(e) {
alert(e);
}
//設置單元格內容居中
xlsheet.Range(xlsheet.Cells(1,1),xlsheet.Cells(rowNum+1,cellsnumber)).HorizontalAlignment =-4108;
xlsheet.Range(xlsheet.Cells(1,1),xlsheet.Cells(1,cellsnumber)).VerticalAlignment =-4108;
xlsheet.Range(xlsheet.Cells(2,1),xlsheet.Cells(rowNum+1,cellsnumber)).Font.Size=10;
//很重要,不能省略,不然會出問題 意思是excel交由用戶控制
xls.UserControl = true;
//消除EXCEL進程,釋放變量
xls=null; xlBook=null; xlsheet=null;
}
</script>
<script>
//另存為
function savehtml() {
document.execCommand('saveas','true','保存為HTML才能再繼續進行EXCEL導出操作!－－<%=fileName%>.html');
alert('現在請到自己電腦上打開剛才保存的.html文件繼續導出操作,當前窗口將進行關閉!');
try {//不提示關閉
window.opener=null;
window.open('','_self');
}catch(e) {}
window.close();
}
</script>
</body>
至此，不管服務器支不支持Ｅxcel組件，都可以得到處理。不過仍然存在幾點細節：
１.客戶端如果沒有安裝Excel，則無法處理，這種情況需要直接輸入table的形式到瀏覽器，暫未研究（也不知道這種情況是否支持單元格當中插入圖片縮略圖與否）
2.如果服務器端支持組件，那當然完美，如果不支持，放到客戶端操作，這時候客戶必須另存為一個.html文件，再打開這個.html文件才能進行Excel數據的最終導出，需要涉及幾個步驟。如果導入數據過多，可能導致速度問題。
至於從Excel導入到Database方面，則比較簡單（因為生成的Excel比較符合規格，編輯時按規格填寫后也不會產生太大差異），直接針Excel文件看成一個數據庫處理，主要代碼：
Dim ConnXls
Set ConnXls=server.createobject("ADODB.CONNECTION")
ConnXls.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&server.mappath(Request.Form("exceluploadpath"))&";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
If Err Then
Response.Write "<font color=red>連接Excle數據庫出錯！"&"</font>"
Err.Clear
Response.End()
End If
Set rsRead = Server.CreateObject("Adodb.RecordSet")
Sql ="SELECT * FROM [Sheet1$]"
rsRead.Open sql,ConnXls,1,3
If Err Then
Response.Write "<font color=red>讀取Excle表出錯！"&"</font>"
Err.Clear
Response.End()
End If
i=0
Dim isAddNew
Do While Not(rsRead.Eof)
isAddNew = False
If isNumeric(trim(""&rsRead(0))) Then
sql="select * from Web_Product Where ID=" & CLng("0"&trim(""&rsRead(0)))
Rs.Open sql,conn,1,3
If rs.Eof Then
rs.AddNew
isAddNew = True
End If
if trim(""&rsRead(Fn(arrField,"P_pid")))="" then
rs("P_pid")=CreateproductID
else
rs("P_pid")=trim(""&rsRead(Fn(arrField,"P_pid")))
end if
rs("P_name")=getstrlen(trim(""&rsRead(Fn(arrField,"P_name"))),100)
rs("P_shortname")=getstrlen(trim(""&rsRead(Fn(arrField,"P_shortname"))),100)
rs("P_volumn")=getstrlen(trim(""&rsRead(Fn(arrField,"P_volumn"))),10)
rs("P_score")=Checknum(trim(""&rsRead(Fn(arrField,"P_score"))),2)
rs("P_Weight")=Checknum(trim(""&rsRead(Fn(arrField,"P_Weight"))),2)
rs("P_MarketPrice")=Checknum(trim(""&rsRead(Fn(arrField,"P_MarketPrice"))),2)
rs("P_MemberPrice")=Checknum(trim(""&rsRead(Fn(arrField,"P_MemberPrice"))),2)
rs("P_newflag")=Checknum(trim(""&rsRead(Fn(arrField,"P_newflag"))),1)
rs("P_Fee")=Checknum(trim(""&rsRead(Fn(arrField,"P_Fee"))),1)
rs("P_Hot")=Checknum(trim(""&rsRead(Fn(arrField,"P_Hot"))),1)
rs("P_Ifalarm")=Checknum(trim(""&rsRead(Fn(arrField,"P_Ifalarm"))),1)
rs("P_Alarmnum")=Checknum(trim(""&rsRead(Fn(arrField,"P_Alarmnum"))),1)
rs("P_Publicate")=1'Checknum(trim(""&rsRead(Fn(arrField,"P_Publicate"))),1)
rs("P_Truegood")=1'Checknum(trim(""&rsRead(Fn(arrField,"P_Truegood"))),1)
rs("P_Recommend")=Checknum(trim(""&rsRead(Fn(arrField,"P_Recommend"))),1)
rs("P_keyword")=getstrlen(trim(""&rsRead(Fn(arrField,"P_keyword"))),500)
rs("P_Description")=getstrlen(trim(""&rsRead(Fn(arrField,"P_Description"))),1000)
rs("P_ShortContent")=getstrlen(trim(""&rsRead(Fn(arrField,"P_ShortContent"))),1000)
if trim(""&rsRead(Fn(arrField,"P_Content")))<>"" then
strcontent=trim(""&rsRead(Fn(arrField,"P_Content")))
else
strcontent=""
end if
'大塊文本是否需要處理
If isAddNew Or need_bigtext_update Then
rs("P_Content")= Replace(strcontent,chr(10),"<br/>")
rs("P_Stock")=Checknum(trim(""&rsRead(Fn(arrField,"P_Stock"))),2)
End If
'默認屬性
If isAddNew Then
rs("P_Addtime")=now()
rs("P_Del")=0
End If
rs.update
rs.close
End If
rsRead.MoveNext
i=i+1
Loop
Call CloseRS(rsRead)
Call CloseConn(ConnXls)
Call CloseRS(rs)
Call CloseConn(Conn)
If Not Err Then
Response.Write("<script>alert('已經成功更新Excel里邊的數據到數據庫！');window.location.href='uploadproduct.asp?action=uploadproductsforupdate';<"&"/script>")
Response.End()
End If
'依據名稱動態獲取單元格序號
Function FN(byVal arrList, byVal strName)
FN = -1
Dim arrI
For arrI = 0 To Ubound(arrList)
If LCase(arrList(arrI) & "") = LCase(strName & "") Then
FN = arrI
Exit For
End If
Next
End Function
Function arrField
arrField = Split("ID,p_sphoto,P_pid,p_name,P_shortName," & _
"P_Content,P_ShortContent,P_volumn,P_score,P_ordernums," & _
"P_weight,P_marketprice,P_memberprice,P_newflag,P_Fee," & _
"P_hot,P_Ifalarm,P_Alarmnum,P_publicate,P_Truegood," & _
"P_Recommend,P_keyword,P_Description,p_stock",",")
End Function
參考：
1.http://www.cnblogs.com/top5/archive/2010/12/29/1920492.html
2.http://www.vbafan.com/2009/01/17/exactly-set-column-of-cell-in-excel/
3.<<Microsoft Excel Visual Basic>>