客户要求：后台的产品那里有个按分类或按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>>