📄 exceltopo.asp
字号:
<!--#include file="../config.ini" -->
<!--#include file="../commfunction.inc" -->
<HTML>
<HEAD>
<META NAME="GENERATOR" Content="Microsoft Visual Studio 6.0">
<link rel="stylesheet" href="../global.CSS">
</HEAD>
<BODY>
<TABLE width=100%>
<TR><TD>
<%
Dim objcheck
Set objcheck=Server.CreateObject("SmartSales.CheckFunction")
objcheck.CheckUserFunction "po","add"
set objcheck=nothing
'建立excel连接
set excelconn=server.createobject("adodb.connection")
filename = Request.ServerVariables("APPL_PHYSICAL_PATH") & "exceltodb/"&request("filename")
excelconn.open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source="&filename
'建立excel记录集
set excelrs=server.createobject("adodb.recordset")
sql="select * from [Sheet1$]"
excelrs.open sql,excelconn,1,1
if not excelrs.eof then
if excelrs.fields(0).name<>"定货日期" then
response.write "格式错误，请检查EXCEL文件<BR>"
%>
<BR>
<input type=button name=ok value="返回" onclick="window.location='po.asp'">
<%
else
'取参数
dim connpara
set connpara=server.CreateObject("adodb.connection")
connpara.Open connstring
set rspara=connpara.Execute("select * from parameter where type='po'")
'取标准条款
set rsterm=connpara.execute("select * from userdefine where closed=0 and definetype='采购条款'")
m=3
do while not rsterm.eof
strtermline=strtermline&m&"、"&replace(rsterm("description"),chr(10),"")&chr(10)
m=m+1
rsterm.movenext
loop
'写入采购单
dim conn
dim rs
set conn=server.CreateObject("adodb.connection")
set rs=server.CreateObject("adodb.recordset")
conn.Open connstring
if request("id")="" then
rs.Open "select top 1 * from po order by poid desc",conn,2,3,1
x=1
for l=1 to rspara("len")'生成编号后缀
x=x*10
next
if not rs.EOF then
x=x+rs("poid")+1
else
x=x+1
end if
rs.AddNew
rs("creator")=session("loginid")
rs("createdate")=now()
rs("pono")=rspara("prefix")&right(x,len(x)-1)
rs("sysaccountid")=getsysaccount("sysaccountid")
else
rs.Open "select * from po where poid="&request("id"),conn,2,3,1
rs("lastmoddate")=now()
rs("lastmoduser")=session("loginid")
end if
rs("approvedate")=null
rs("approver")=null
rs("status")="初始"
rs("accountid")=74
rs("Contactid")=-1
rs("Term")=-1
rs("ShipVia")=-1
rs("CurrencyCode")=-1
rs("poDate")=date()
rs("Owner")=session("loginid")
rs("TotalAmount")=0
rs("termline")=strtermline
rs("description")="从excel导入的采购单"
rs.Update
rs.Close
'取poid
rs.Open "select poid from po order by poid desc",conn,1,1
strpoid=rs("poid")
rs.Close
do while not excelrs.eof
set rspro=conn.Execute("select * from product where model='"&excelrs("型号")&"' and productcode='"&excelrs("货号")&"'")
if not rspro.eof then
'写入明细
rs.Open "select * from poline",conn,2,3,1
rs.addnew()
rs("poid")=strpoid
rs("productid")=rspro("productid")
rs("qty")=excelrs("数量")
rs("price")=excelrs("单价")
rs("expecteddate")=date()
rs("confirmeddate")=date()
rs("amount")=ccur(excelrs("合计"))
rs("slipno")=excelrs("SLIP")
rs("issuedqty")=0
rs("specialpriceno")=excelrs("特价客户编号")
rs("description")=excelrs("定单号")
rs.Update
rs.close
Response.Write "成功导入型号:<font color=red>"&excelrs("型号")&"</font><br>"
else
Response.Write "产品库中没有找到型号:<font color=red>"&excelrs("型号")&"</font>，此产品未自动添加到采购单，请手工加入<br>"
end if
excelrs.movenext
loop
excelrs.close()
set excelrs=nothing
set rs=conn.Execute("select sum(amount) as totalamount from poline where poid="&strpoid)
strtotalamount=rs("totalamount")
conn.Execute("update po set totalamount="&strtotalamount&" where poid="&strpoid)
set rs=nothing
conn.Close
set conn=nothing
%>
<br>
<input type=button name=ok value="完成" onclick="window.location='po.asp'">
<%
end if
else
Response.Write "无产品明细"
%>
<BR>
<input type=button name=ok value="返回" onclick="window.location='po.asp'">
<%
Response.End
end if
excelconn.Close()
set excelconn=nothing
dim fso
Set fso=Server.CreateObject("Scripting.FileSystemObject")
Set f1 = fso.GetFile(filename)
' 删除文件。
f1.Delete
%>
</TD></TR></TABLE>
</BODY>
</HTML>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -