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

''只在EXCEL文件到服务器
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>


至此,不管服务器支不支持Excel组件,都可以得到处理。不过仍然存在几点细节:

1.客户端如果没有安装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>>

posted on 2012-03-28 09:45  Dream Young  阅读(4629)  评论(0编辑  收藏  举报