任我行/管家婆导入EXCEL ACCESS数据

来源：互联网发布：说明书制作软件编辑：程序博客网时间：2024/04/29 23:57
<%
'response.write ASC("+")&""&request("aaa") 
'<!-- 
'程序名：   Grasp_InData.asp 
'程序功能：  导入导出管家婆库存商品类别EXCEL数据 
'       导入ACCESS单据 
'开发者：   Linyee 
'联系我：   QQ249033420 
'Email:     mythinker@2911.net 
'Home:      www.linyee.net  blog-hi.baidu.com/jiaguoxinzhi  blog.csdn.net/jiaguoxinzhi/ 
'--> 
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&"</br>"    '调试用于查看哪个字段不正确 
        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&"</br>"    '调试用于查看哪个字段不正确 
            '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()%>
<form action="" method="post" enctype="application/x-www-form-urlencoded" name="form1">
  <table width="98%"  border="1">
    <tr>
      <td>EXCEL文件</td>
      <td><input name="xls" type="file" size="80" path="<%=strPath%>"></td>
    </tr>
    <tr>
      <td>SQL</td>
      <td>服务器
        <input name="svr" type="text" value="<%=SqlIp%>">
        数据库
        <input name="db" type="text" value="<%=SqlName%>">
        用户
        <input name="un" type="text" value="sa">
        口令 
        <input name="up" type="password" value="jiaguo">               
</td>
    </tr>
    <tr>
      <td> </td>
      <td>表名：
        <input name="tbl" type="text" id="tbl" value="<%=ExcelTbl%>">
      本操作仅适用于本机导入，因管家婆2005辉煌版数据导入所需而做，用于其它地方可能会产生错误。</td>
    </tr>
    <tr>
      <td><a href="?">返回</a></td>
      <td align="center">EXCEL
        <input name="daolu" type="submit" id="daolu" value="导入">
      到SQL
        <input name="daocu" type="submit" id="daocu" value="导出">
        到EXCEL ACCESS
        <input name="daocuTxt" type="submit" id="daocuTxt" value="导出">
        导出为文本</td>
    </tr>
    <tr>
      <td>说明</td>
      <td valign="middle"><p>1、商品类别，表名ptype。</p>
      <p>2、草稿单据，从ACCESS导出，有“进货”字样为进货，其它为出货。导出后，查看源代码另存为文本即可用于管家婆的单据导入，省却对表的直接操作。</p></td>
    </tr>
  </table>
</form>
<%End Sub%>
任我行/管家婆 导入EXCEL ACCESS数据

任我行/管家婆导入EXCEL ACCESS数据
