任我行/管家婆 导入EXCEL ACCESS数据
- <%
- 'response.write ASC("+")&""&request("aaa")
- '
- Dim SqlName
- SqlName =request.form("db")
- if SqlName="" then SqlName="debnC"
- Dim SqlIp
- SqlIp =request.form("svr")
- if SqlIp="" then SqlIp="127.0.0.1"
- Dim SqlUser
- SqlUser =request.form("un")
- Dim SqlPass
- SqlPass =request.form("up")
- strPath =request.form("xls")
- 'response.write strPath
- 'strPath ="E:/德标管业/_公司文件/类别.XLS"
- ExcelTbl=request.form("tbl")
- if ExcelTbl="" then ExcelTbl="ptype"
- Dim Dx,DanType
- Dim G1,G2
- Dim objConn1,objConn
- Dim objRs1,objRs
- if request.form("daolu")="导入" and strPath<>"" then call Command1_Click:response.end
- if request.form("daocu")="导出" and strPath<>"" then call Command2_Click:response.end
- if request.form("daocuTxt")="导出" and strPath<>"" then call Command3_Click:response.end
- call ShowDiog
- ''将ACCES导出为文本
- Sub Command3_Click()
- ''SQL连接
- on error resume next
- 'ExcelTbl="查询_出货单"
- ''ACCESS连接
- Set objConn1 = server.CreateObject("ADODB.Connection")
- objConn1.Provider = "Microsoft.Jet.OLEDB.4.0 "
- objConn1.ConnectionString = "Data Source=" & strPath & ";Persist Security Info=False;Jet OLEDB:Database Password=123"
- objConn1.Open
- if err.number<>0 then response.write "2"&err.description:response.end
- Set objRs1 = server.CreateObject("ADODB.Recordset")
- objRs1.Open "select * from ["&ExcelTbl"]", objConn1, 1, 1
- Set Rs = server.CreateObject("ADODB.Recordset")
- if err.number<>0 then response.write "3"&err.description:response.end
- ''完全导入
- 'objConn.execute "SELECT * INTO ptype FROM OPENROWSET('MICROSOFT.JET.OLEDB.4.0', 'Excel 5.0;HDR=YES;DATABASE="&strPath&"', "&ExcelTbl&"$) Rowset_1"
- ''导出数据 ;管家婆导出数据格式
- '管家婆辉煌版8.x
- '单序 P 进货单 科号 现 金 单位号 单位 人员号 人员 主仓库 仓库号 单号 2008-09-01 摘要
- '单序 P1 空白 编号 名称 数量 进货价 进货额 折让 进货价 进货额 税点 进货价 税金 备注
- '1 A 101 现 金 100480.6 '会计科目实收实付
- 'EXCEL表头
- '00 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16
- '编号 序号 名称 颜色 规格 单位 数量 零售价 进货价 进货额 件量 备注 单号 日期 类别 件数 业务员
- '版本题头
- Dx=(right("0000000000"&objrs1(12),5)) '单号后四位
- if not isnumeric(Dx) then Dx=(left(right(objrs1(12),5),4))"01":err.clear '单号后四位
- response.write "管家婆辉煌版8.x" '摘要
- response.write vbcrlf '换行
- '单据摘要
- call WriteTitle
- if err.number<>0 then response.write "4"&err.description:response.end
- while not objrs1.eof
- if objrs1(2)="合计" then
- '1 A 101 现 金 100480.6 '会计科目实收实付
- '未收不建立会计科目实收实付
- if IsNumeric(objrs1(6)) then
- response.write dx&vbtab '单序
- response.write "A"&vbtab '标识
- response.write "101"&vbtab '结算编号
- response.write "现 金"&vbtab '现 金
- response.write objrs1(6)&vbtab '数量当实收实付
- 'response.write (0-objrs1(9))&vbtab '数量为空时则置负
- response.write vbcrlf '换行
- end if
- objRs1.movenext
- if objRs1.eof then response.end '如果是结束就就束
- '版本题头
- Dx=(right(objrs1(12),5)) '单号后四位
- if not isnumeric(Dx) then Dx=(left(right(objrs1(12),5),4))"01":err.clear '单号后四位
- 'response.write "管家婆辉煌版8.x" '摘要
- 'response.write vbcrlf '换行
- '单据摘要
- call WriteTitle
- end if
- '记录生成
- if objrs1(6)<>"" then call WriteRecord
- objRs1.movenext
- wend
- response.write ";导入完成！"
- End Sub
- '写记录
- sub WriteRecord()
- response.write dx&vbtab '单序
- response.write "P1"&vbtab '标识
- response.write ""&vbtab '空白
- response.write objrs1(1)&vbtab '编号
- response.write objrs1(2)&vbtab '名称
- response.write objrs1(6)&vbtab '数量
- response.write objrs1(8)&vbtab '进货价
- response.write objrs1(9)&vbtab '进货额
- response.write "1"&vbtab '折让
- response.write objrs1(8)&vbtab '进货价
- response.write objrs1(9)&vbtab '进货额
- response.write "0"&vbtab '税点
- response.write objrs1(8)&vbtab '进货价
- response.write "0"&vbtab '税金
- response.write objrs1(11) '备注
- response.write vbcrlf '换行
- End Sub
- '写表头
- sub WriteTitle()
- response.write dx&vbtab '单序
- response.write "P"&vbtab '标识
- if instr(ExcelTbl,"进货") then
- DanType="JH"
- if objrs1(6)<0 then
- response.write "进货退货"&vbtab '进货单
- DanType="JHT"
- else
- response.write "进货单"&vbtab '进货单
- end if
- else
- DanType="DB"
- if objrs1(6)<0 then
- response.write "销售退货"&vbtab '进货单
- DanType="DBT"
- else
- response.write "销售单"&vbtab '进货单
- end if
- end if
- response.write "101"&vbtab '结算编号
- response.write "现 金"&vbtab '现 金
- response.write ""&vbtab '单位编号
- if objrs1(11)<>"" then
- response.write objrs1(11)&vbtab '单位
- else
- response.write "德标"&vbtab '业务
- end if
- response.write ""&vbtab '人员号
- if objrs1(16)<>"" then
- response.write objrs1(16)&vbtab '业务
- else
- response.write "公司"&vbtab '业务
- end if
- response.write "主仓库"&vbtab '仓库
- response.write "001"&vbtab '仓库号
- response.write DanType&objrs1(12)&vbtab '单号
- G1=split(""&objrs1(13),"-")
- G2=G1(0)"-"&right("00"&G1(1),2)"-"&right("00"&G1(2),2)
- response.write G2&vbtab '日期
- response.write "" '摘要
- response.write vbcrlf '换行
- End Sub
- '商品库类别字段
- 'ID 父ID 级/进深 子类数 1级子数 修改？ 编号 条码 名称 简称 规格 型号 产地
- '单位 单位2 关系1 关系2 价1 价2 价3 零价 保质月 保质天 备注 价X 删除？
- '加权等 PinYin 顺序上 顺序下 自动数 父级数 价X1 最低价 索引
- ''将EXCEL导入到SQL中
- Sub Command1_Click()
- ''SQL连接
- Dim connStr
- on error resume next
- Set objConn = server.CreateObject("adodb.connection")
- objConn.ConnectionTimeout = 60
- objConn.CommandTimeout = 60
- objConn.CursorLocation = 3
- connStr="Provider=SQLOLEDB.1;Persist Security Info=False;User ID="&SqlUser";Password="&SqlPass";Initial Catalog=" & SqlName & ";Data Source=" & SqlIp & ""
- objConn.Open connStr
- 'response.write connStr
- if err.number<>0 then response.write "0"&err.description:response.end
- objConn.execute "delete from "&ExcelTbl" where 1=1 " '先清空商品表
- Set objRs = server.CreateObject("ADODB.Recordset")
- objRs.Open "select * from "&ExcelTbl" where 0=1", objConn, 3, 3
- if err.number<>0 then response.write "1"&err.description:response.end
- ''EXCEL连接
- Set objConn1 = server.CreateObject("ADODB.Connection")
- objConn1.Provider = "Microsoft.Jet.OLEDB.4.0 "
- objConn1.ConnectionString = "Data Source=" & strPath & ";" & "Extended Properties=Excel 8.0;"
- objConn1.Open
- if err.number<>0 then response.write "2"&err.description:response.end
- Set objRs1 = server.CreateObject("ADODB.Recordset")
- objRs1.Open "select * from ["&ExcelTbl"$]", objConn1, 1, 1
- if err.number<>0 then response.write "3"&err.description:response.end
- Set Rs = server.CreateObject("ADODB.Recordset")
- ''完全导入
- 'objConn.execute "SELECT * INTO ptype FROM OPENROWSET('MICROSOFT.JET.OLEDB.4.0', 'Excel 5.0;HDR=YES;DATABASE="&strPath&"', "&ExcelTbl&"$) Rowset_1"
- ''导入数据
- Dim Pid
- while not objrs1.eof
- objRs.addnew
- for fori=0 to objRs.fields.count-1
- 'response.write fori&"|" '调试用于查看哪个字段不正确
- if fori<>30 and fori<>31 then '30自动编号
- objRs(fori)=objRs1(fori)
- end if
- if fori=31 then '30自动编号
- rs.open "select [Rec] from "&ExcelTbl" where typeId='"&objRs1(1)"'",objConn, 1, 1
- objRs(31)=rs(0)
- rs.close
- end if
- next
- response.write "导入"&objRs(0)"完成！"
- objRs.update
- objRs.Requery
- 'objRs.movenext
- objRs1.movenext
- wend
- response.write "导入完成！"
- End Sub
- ''将SQL中导出到EXCEL
- Sub Command2_Click()
- ''EXCEL连接
- on error resume next
- Set objConn = server.CreateObject("ADODB.Connection")
- objConn.Provider = "Microsoft.Jet.OLEDB.4.0 "
- objConn.ConnectionString = "Data Source=" & strPath & ";" & "Extended Properties=Excel 8.0;"
- objConn.Open
- if err.number<>0 then response.write "1"&err.description:response.end
- ''SQL连接
- Set objConn1 = server.CreateObject("adodb.connection")
- objConn1.ConnectionTimeout = 60
- objConn1.CommandTimeout = 60
- objConn1.CursorLocation = 3
- objConn1.Open "Provider=SQLOLEDB.1;Persist Security Info=False;User ID="&SqlUser";Password="&SqlPass";Initial Catalog=" & SqlName & ";Data Source=" & SqlIp & ""
- if err.number<>0 then response.write "2"&err.description:response.end
- Set objRs = server.CreateObject("ADODB.Recordset")
- objRs.Open "select * from ["&ExcelTbl"1$]", objConn, 3, 3
- Set objRs1 = server.CreateObject("ADODB.Recordset")
- objRs1.Open "select * from "&ExcelTbl"", objConn1, 1, 1
- if err.number<>0 then response.write "3"&err.description:response.end
- Dim i
- Dim strValue '存放内容
- Dim strTitle '存放表头
- Dim strSql
- ''导入题头
- objRs.addnew
- for fori=0 to objRs.fields.count-1
- 'response.write fori&"" '调试用于查看哪个字段不正确
- objRs(fori)=objRs1(fori).name
- next
- response.write "导出题头"&objrs1(0)"完成！"
- objRs.update
- 'objRs.movenext
- while not objrs1.eof
- objRs.addnew
- for fori=0 to objrs1.fields.count-1
- 'response.write fori&"" '调试用于查看哪个字段不正确
- 'if fori<>30 then '30自动编号
- objRs(fori)=objRs1(fori)
- 'end if
- next
- response.write "导出"&objrs1(0)"完成！"
- objRs.update
- 'objRs.movenext
- objRs1.movenext
- 'if err.number<>0 then response.write "4-"&fori&err.description:response.end
- wend
- response.write "导出完成！"
- End Sub
- %>
- <%
- %>
- <%sub ShowDiog()%>
-
-
EXCEL文件 -
SQL 服务器 - 数据库
- 用户
- 口令
-
表名： - 本操作仅适用于本机导入，因管家婆2005辉煌版数据导入所需而做，用于其它地方可能会产生错误。
-
- 到SQL
- 到EXCEL ACCESS
- 导出为文本
-
说明 1、商品类别，表名ptype。
2、草稿单据，从ACCESS导出，有“进货”字样为进货，其它为出货。导出后，查看源代码另存为文本即可用于管家婆的单据导入，省却对表的直接操作。
- <%End Sub%>