U811.1接口EAI系列之六--物料上传--VB语言

1. 业务系统同步U811.1存货档案通用方法.

2.具体代码处理如下：

作者：王春天 2013-11-06

地址：http://www.cnblogs.com/spring_wang/p/3409844.html

代码中调用的通用方法在: http://www.cnblogs.com/spring_wang/p/3393147.html

'物料信息生成XML
Public Function xml_inventory(ds_data As adodb.Recordset, as_proc As String) As Boolean
xml_inventory = False
    Dim ls_xml As String
    Dim ls_sender As String
    Dim ls_code As String '物料编码
    Dim ls_name As String '物料名称
    Dim ls_type As String '物料类别
    Dim ls_unit As String '主计量单位
    Dim ls_part_unit As String '物料其它单位
    Dim ls_unit_group As String '物料单位组
    Dim ls_bProxyForeign As String '是否委外0-否；1-是
    Dim ls_purchase_flag As String '是否外购0-否；1-是
    Dim ls_sale_flag As String '是否内销0-否；1-是
    Dim ls_selfmake_flag As String '是否自制0-否；1-是
    Dim ls_bexpsale As String '是否外销0-否；1-是
    Dim ls_prod_consu_flag  '是否生产耗用
    Dim ls_pro_sale_price As String '计划价 / 售价
    Dim ls_pricetype As String '计价方式(计划价法 / 全月平均法)
    Dim ls_inv_position As String '货位编码
    Dim ls_defwarehouse As String ' 默认仓库编码
    
    '此数据需要在数据库中配置
    ls_sender = U8_XTM
    
    
    '以下数据从传入的DATASET中获取
    ls_bProxyForeign = "0" '是否委外0-否；1-是
    ls_purchase_flag = "1" '是否采购0-否；1-是
    ls_sale_flag = "1" '是否内销0-否；1-是
    ls_selfmake_flag = "1" '是否自制0-否；1-是
    ls_bexpsale = "1" '是否外销0-否；1-是
    
    If U(ds_data.Fields("kclybz").Value) = "Z" Then
        ls_selfmake_flag = "1"
    End If
    
    ls_code = U(ds_data.Fields("kcwpdm").Value) '"A0001" '物料编码
    ls_name = Trim(ds_data.Fields("kcwpmc").Value) '"修改后名称" '物料名称
    
    ls_type = ds_data.Fields("kccpbs").Value '"02" '物料类别
    
    ls_unit = U(ds_data.Fields("kckcdw").Value) '"002002" '主计量单位
    ls_part_unit = ds_data.Fields("kccgdw").Value '"002002" '物料其它单位
    ls_unit_group = "01" '物料单位组
    ls_prod_consu_flag = "1" '是否生产耗用
  
    
'期初数据才上传计划价，等上线后去掉上传计划价Start
    ls_pricetype = "计划价法" '计价方式(计划价法/全月平均法)
    If U(ds_data.Fields("kccbhs").Value) = "S" Then
        ls_pricetype = "全月平均法"
    End If
    If ds_data.Fields("kcjhcb").Value = "" Then
        ls_pro_sale_price = 0 '计划价 / 售价
    Else
        ls_pro_sale_price = ds_data.Fields("kcjhcb").Value '计划价 / 售价
    End If
'期初数据才上传计划价，等上线后去掉上传计划价End
    
    ls_inv_position = "" '货位编码
    If U(ds_data.Fields("kcqshw").Value) <> "" Then
        ls_inv_position = U(ds_data.Fields("kcqshw").Value) '货位编码
    End If
    
    ls_defwarehouse = "" '默认仓库编码
    If U(ds_data.Fields("kcqsck").Value) <> "" Then
        ls_defwarehouse = U(ds_data.Fields("kcqsck").Value) '默认仓库编码
    End If
    
    '增加文件头相关信息
    ls_xml = "<?xml version=""1.0"" encoding=""UTF-8""?>" + vbCrLf
    
    ls_xml = ls_xml & "<ufinterface sender=""" & ls_sender & """ receiver=""u8"" roottag=""inventory"" docid="""" proc=""" & as_proc & """ renewproofno = ""N"" codeexchanged=""N"" exportneedexch=""N"" display="""" family="""" timestamp="""">" + vbCrLf
    
    '增加文件中数据项信息 header
    ls_xml = ls_xml & "<inventory>" + vbCrLf
    ls_xml = ls_xml & "<header>" + vbCrLf
    
   
'期初数据才上传计划价，等上线后去掉上传计划价Start
    ls_xml = ls_xml & "<pro_sale_price>" & ls_pro_sale_price & "</pro_sale_price>" + vbCrLf '计划价 / 售价
    ls_xml = ls_xml & "<pricetype>" & ls_pricetype & "</pricetype>" + vbCrLf '计价方式(计划价法 / 全月平均法)
'期初数据才上传计划价，等上线后去掉上传计划价End
 
    ls_xml = ls_xml & "<inv_position>" & ls_inv_position & "</inv_position>" + vbCrLf '货位编码
    ls_xml = ls_xml & "<defwarehouse>" & ls_defwarehouse & "</defwarehouse>" + vbCrLf '默认仓库编码
    
    ls_xml = ls_xml & "<code>" & ls_code & "</code>" + vbCrLf '物料编码
    ls_xml = ls_xml & "<name>" & ls_name & "</name>" + vbCrLf '物料名称
    ls_xml = ls_xml & "<sort_code>" & ls_type & "</sort_code>" + vbCrLf '存货分类
    ls_xml = ls_xml & "<main_measure>" & ls_unit & "</main_measure>" + vbCrLf '主计量单位编码
    ls_xml = ls_xml & "<sale_flag>" & ls_sale_flag & "</sale_flag>" + vbCrLf '是否内销 0 1
    ls_xml = ls_xml & "<purchase_flag>" & ls_purchase_flag & "</purchase_flag>" + vbCrLf '是否外购 0 1
    ls_xml = ls_xml & "<selfmake_flag>" & selfmake_flag & "</selfmake_flag>" + vbCrLf '是否自制 0 1
    ls_xml = ls_xml & "<prod_consu_flag>" & ls_prod_consu_flag & "</prod_consu_flag>" + vbCrLf '是否生产耗用 0 1
    ls_xml = ls_xml & "<in_making_flag>" & "0" & "</in_making_flag>" + vbCrLf '是否在制 0 1
    ls_xml = ls_xml & "<tax_serv_flag>" & "0" & "</tax_serv_flag>" + vbCrLf '是否应税劳务 0 1
    ls_xml = ls_xml & "<suit_flag>" & "0" & "</suit_flag>" + vbCrLf '是否成套件 0 1
    ls_xml = ls_xml & "<qlty_guarantee_flag>" & "0" & "</qlty_guarantee_flag>" + vbCrLf '是否保质期管理 0 1
    ls_xml = ls_xml & "<batch_flag>" & "0" & "</batch_flag>" + vbCrLf '是否批次管理 0 1
    ls_xml = ls_xml & "<entrust_flag>" & "0" & "</entrust_flag>" + vbCrLf '是否受托代销 0 1
    ls_xml = ls_xml & "<backlog_flag>" & "0" & "</backlog_flag>" + vbCrLf '是否呆滞积压 0 1
    ls_xml = ls_xml & "<free_item1>" & "0" & "</free_item1>" + vbCrLf '存货是否有自由项1 0 1
    ls_xml = ls_xml & "<free_item2>" & "0" & "</free_item2>" + vbCrLf '存货是否有自由项2 0 1
    ls_xml = ls_xml & "<free_item3>" & "0" & "</free_item3>" + vbCrLf '存货是否有自由项3 0 1
    ls_xml = ls_xml & "<free_item4>" & "0" & "</free_item4>" + vbCrLf '存货是否有自由项4 0 1
    ls_xml = ls_xml & "<free_item5>" & "0" & "</free_item5>" + vbCrLf '存货是否有自由项5 0 1
    ls_xml = ls_xml & "<free_item6>" & "0" & "</free_item6>" + vbCrLf '存货是否有自由项6 0 1
    ls_xml = ls_xml & "<free_item7>" & "0" & "</free_item7>" + vbCrLf '存货是否有自由项7 0 1
    ls_xml = ls_xml & "<free_item8>" & "0" & "</free_item8>" + vbCrLf '存货是否有自由项8 0 1
    ls_xml = ls_xml & "<free_item9>" & "0" & "</free_item9>" + vbCrLf '存货是否有自由项9 0 1
    ls_xml = ls_xml & "<free_item10>" & "0" & "</free_item10>" + vbCrLf '存货是否有自由项10 0 1
    ls_xml = ls_xml & "<btrack>" & "0" & "</btrack>" + vbCrLf '出库跟踪入库 0 1
    ls_xml = ls_xml & "<bserial>" & "0" & "</bserial>" + vbCrLf '是否序列号管理 0 1
    ls_xml = ls_xml & "<bbarcode>" & "0" & "</bbarcode>" + vbCrLf '条形码管理 0 1
'    ls_xml = ls_xml & "<unitgroup_type>" & "1" & "</unitgroup_type>" + vbCrLf '计量单位组类别
    ls_xml = ls_xml & "<unitgroup_code>" & ls_unit_group & "</unitgroup_code>" + vbCrLf '计量单位组编码
    ls_xml = ls_xml & "<solitude>" & "0" & "</solitude>" + vbCrLf '是否单独存放 0 1
    ls_xml = ls_xml & "<specialties>" & "0" & "</specialties>" + vbCrLf '特殊药品标志 0 1
    ls_xml = ls_xml & "<PropertyCheck>" & "0" & "</PropertyCheck>" + vbCrLf '是否质检 0 1
    ls_xml = ls_xml & "<RecipeBatch>" & "0" & "</RecipeBatch>" + vbCrLf '是否处方药 0 1
    ls_xml = ls_xml & "<bPlanInv>" & "0" & "</bPlanInv>" + vbCrLf '是否计划品 0 1
    ls_xml = ls_xml & "<bProxyForeign>" & ls_bProxyForeign & "</bProxyForeign>" + vbCrLf '是否委外 0 1
    ls_xml = ls_xml & "<bATOModel>" & "0" & "</bATOModel>" + vbCrLf 'ATO 0 1
    ls_xml = ls_xml & "<bCheckItem>" & "0" & "</bCheckItem>" + vbCrLf '是否选项类 0 1
    ls_xml = ls_xml & "<bPTOModel>" & "0" & "</bPTOModel>" + vbCrLf 'PTO 0 1
    ls_xml = ls_xml & "<bequipment>" & "0" & "</bequipment>" + vbCrLf '是否备件 0 1
    ls_xml = ls_xml & "<bMPS>" & "0" & "</bMPS>" + vbCrLf '是否MPS件 0 1
    ls_xml = ls_xml & "<bROP>" & "0" & "</bROP>" + vbCrLf '是否ROP件 0 1
    ls_xml = ls_xml & "<bRePlan>" & "0" & "</bRePlan>" + vbCrLf '是否重复计划 0 1
    ls_xml = ls_xml & "<bBillUnite>" & "0" & "</bBillUnite>" + vbCrLf '是否令单合并 0 1
    ls_xml = ls_xml & "<bCutMantissa>" & "0" & "</bCutMantissa>" + vbCrLf '是否切除尾数 0 1
    ls_xml = ls_xml & "<bInTotalCost>" & "1" & "</bInTotalCost>" + vbCrLf '成本相关 0 1
    ls_xml = ls_xml & "<iSupplyType>" & "0" & "</iSupplyType>" + vbCrLf '供应类型 0 1
    ls_xml = ls_xml & "<bConfigFree1>" & "0" & "</bConfigFree1>" + vbCrLf '结构性自由项1 0 1
    ls_xml = ls_xml & "<bConfigFree2>" & "0" & "</bConfigFree2>" + vbCrLf '结构性自由项2 0 1
    ls_xml = ls_xml & "<bConfigFree3>" & "0" & "</bConfigFree3>" + vbCrLf '结构性自由项3 0 1
    ls_xml = ls_xml & "<bConfigFree4>" & "0" & "</bConfigFree4>" + vbCrLf '结构性自由项4 0 1
    ls_xml = ls_xml & "<bConfigFree5>" & "0" & "</bConfigFree5>" + vbCrLf '结构性自由项5 0 1
    ls_xml = ls_xml & "<bConfigFree6>" & "0" & "</bConfigFree6>" + vbCrLf '结构性自由项6 0 1
    ls_xml = ls_xml & "<bConfigFree7>" & "0" & "</bConfigFree7>" + vbCrLf '结构性自由项7 0 1
    ls_xml = ls_xml & "<bConfigFree8>" & "0" & "</bConfigFree8>" + vbCrLf '结构性自由项8 0 1
    ls_xml = ls_xml & "<bConfigFree9>" & "0" & "</bConfigFree9>" + vbCrLf '结构性自由项9 0 1
    ls_xml = ls_xml & "<bConfigFree10>" & "0" & "</bConfigFree10>" + vbCrLf '结构性自由项10 0 1
    ls_xml = ls_xml & "<bPeriodDT>" & "0" & "</bPeriodDT>" + vbCrLf '是否周期检验 0 1
    ls_xml = ls_xml & "<bimportmedicine>" & "0" & "</bimportmedicine>" + vbCrLf '是否进口药品 0 1
    ls_xml = ls_xml & "<bfirstbusimedicine>" & "0" & "</bfirstbusimedicine>" + vbCrLf '是否首营药品 0 1
    ls_xml = ls_xml & "<bforeexpland>" & "0" & "</bforeexpland>" + vbCrLf '预测展开 0 1
    ls_xml = ls_xml & "<fconvertrate>" & "1" & "</fconvertrate>" + vbCrLf '转换因子 0 1
    ls_xml = ls_xml & "<binvmodel>" & "0" & "</binvmodel>" + vbCrLf '模型 0 1
    ls_xml = ls_xml & "<bexpsale>" & ls_bexpsale & "</bexpsale>" + vbCrLf '是否外销 0 1
    ls_xml = ls_xml & "<bcheckbsatp>" & "0" & "</bcheckbsatp>" + vbCrLf '检查售前ATP 0 1
    ls_xml = ls_xml & "<bcheckfree1>" & "0" & "</bcheckfree1>" + vbCrLf '核算自由项1 0 1
    ls_xml = ls_xml & "<bcheckfree2>" & "0" & "</bcheckfree2>" + vbCrLf '核算自由项2 0 1
    ls_xml = ls_xml & "<bcheckfree3>" & "0" & "</bcheckfree3>" + vbCrLf '核算自由项3 0 1
    ls_xml = ls_xml & "<bcheckfree4>" & "0" & "</bcheckfree4>" + vbCrLf '核算自由项4 0 1
    ls_xml = ls_xml & "<bcheckfree5>" & "0" & "</bcheckfree5>" + vbCrLf '核算自由项5 0 1
    ls_xml = ls_xml & "<bcheckfree6>" & "0" & "</bcheckfree6>" + vbCrLf '核算自由项6 0 1
    ls_xml = ls_xml & "<bcheckfree7>" & "0" & "</bcheckfree7>" + vbCrLf '核算自由项7 0 1
    ls_xml = ls_xml & "<bcheckfree8>" & "0" & "</bcheckfree8>" + vbCrLf '核算自由项8 0 1
    ls_xml = ls_xml & "<bcheckfree9>" & "0" & "</bcheckfree9>" + vbCrLf '核算自由项9 0 1
    ls_xml = ls_xml & "<bcheckfree10>" & "0" & "</bcheckfree10>" + vbCrLf '核算自由项10 0 1
    ls_xml = ls_xml & "<bbommain>" & "1" & "</bbommain>" + vbCrLf '允许BOM母件 0 1
    ls_xml = ls_xml & "<bbomsub>" & "1" & "</bbomsub>" + vbCrLf '允许BOM子件 0 1
    ls_xml = ls_xml & "<bproductbill>" & "0" & "</bproductbill>" + vbCrLf '允许生产订单 0 1
    ls_xml = ls_xml & "<icheckatp>" & "0" & "</icheckatp>" + vbCrLf '检查ATP 0 1
    ls_xml = ls_xml & "<bpiece>" & "0" & "</bpiece>" + vbCrLf '计件 0 1
    ls_xml = ls_xml & "<bsrvitem>" & "0" & "</bsrvitem>" + vbCrLf '服务项目 0 1
    ls_xml = ls_xml & "<bsrvfittings>" & "0" & "</bsrvfittings>" + vbCrLf '务配件 0 1
    ls_xml = ls_xml & "<bPUQuota>" & "0" & "</bPUQuota>" + vbCrLf '参与配额 0 1
    ls_xml = ls_xml & "<bInvROHS>" & "0" & "</bInvROHS>" + vbCrLf 'ROHS物料 0 1
    ls_xml = ls_xml & "<bprjmat>" & "0" & "</bprjmat>" + vbCrLf '是否工程物料 0 1
    ls_xml = ls_xml & "<binvasset>" & "0" & "</binvasset>" + vbCrLf '资产 0 1
    ls_xml = ls_xml & "<bsrvproduct>" & "0" & "</bsrvproduct>" + vbCrLf '服务产品 0 1
    ls_xml = ls_xml & "<iAcceptDelayDays>" & "0" & "</iAcceptDelayDays>" + vbCrLf '允许延后天数 0 1
    ls_xml = ls_xml & "<iPlanCheckDay>" & "0" & "</iPlanCheckDay>" + vbCrLf '计划检验天数 0 1
'    ls_xml = ls_xml & "<iMaterialsCycle>" & "0" & "</iMaterialsCycle>" + vbCrLf '用料周期
    ls_xml = ls_xml & "<bSCkeyProjections>" & "0" & "</bSCkeyProjections>" + vbCrLf '投产推算关键子件 0 1
    ls_xml = ls_xml & "<iSupplyPeriodType>" & "0" & "</iSupplyPeriodType>" + vbCrLf '供应期间类型 0 1
    ls_xml = ls_xml & "<iAvailabilityDate>" & "1" & "</iAvailabilityDate>" + vbCrLf '可用日期 0 1
    ls_xml = ls_xml & "<iPlanCheckDay>" & "0" & "</iPlanCheckDay>" + vbCrLf '计划检验天数 0 1
    ls_xml = ls_xml & "<cPlanMethod>" & "R" & "</cPlanMethod>" + vbCrLf '计划方法
    ls_xml = ls_xml & "<cSRPolicy>" & "PE" & "</cSRPolicy>" + vbCrLf '供需政策
    ls_xml = ls_xml & "<idrawtype>" & "0" & "</idrawtype>" + vbCrLf '领料方式
    
    ls_xml = ls_xml & "<puunit_code>" & ls_part_unit & "</puunit_code>" + vbCrLf '采购默认计量单位编码
    ls_xml = ls_xml & "<saunit_code>" & ls_part_unit & "</saunit_code>" + vbCrLf '销售默认计量单位编码
    ls_xml = ls_xml & "<stunit_code>" & ls_part_unit & "</stunit_code>" + vbCrLf '库存默认计量单位编码
    ls_xml = ls_xml & "<caunit_code>" & ls_part_unit & "</caunit_code>" + vbCrLf '成本默认辅计量编码
    ls_xml = ls_xml & "<cProductUnit>" & ls_part_unit & "</cProductUnit>" + vbCrLf '生产计量单位编码
    
    ls_xml = ls_xml & "</header>" + vbCrLf
    'body
    ls_xml = ls_xml & "<body>" + vbCrLf
    ls_xml = ls_xml & "<entry>" + vbCrLf
    
    ls_xml = ls_xml & "<invcode>" & ls_code & "</invcode>" + vbCrLf '存货编码  和上面保持一致
    
    ls_xml = ls_xml & "</entry>" + vbCrLf
    ls_xml = ls_xml & "</body>" + vbCrLf
    
    '增加文件尾相关信息
    ls_xml = ls_xml & "</inventory>" + vbCrLf
    ls_xml = ls_xml & "</ufinterface>" + vbCrLf
    
    
     Dim xml_document As New DOMDocument
    xml_document.loadXML (ls_xml)
    fn2 = App.Path & "\u8_inventory.xml"
    xml_document.Save (fn2)
    
    
    Dim ls_temp As String '接收返回消息，如果成功，返回U8中物料代码，如果失败，返回错误信息
    If SendToEAI(ls_xml, ls_temp) Then '成功
        xml_inventory = True
    Else '失败
        MsgBox ls_temp
    End If
End Function