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 '是否生产耗用 '此数据需要在数据库中配置 ls_sender = U8_XTM '以下数据从传入的DATASET中获取 ls_bProxyForeign = "0" '是否委外0-否;1-是 ls_purchase_flag = "1" '是否采购0-否;1-是 ls_sale_flag = "0" '是否内销0-否;1-是 ls_selfmake_flag = "0" '是否自制0-否;1-是 ls_bexpsale = "0" '是否外销0-否;1-是 ls_code = U(ds_data.Fields("kcwpdm").Value) '"A0001" '物料编码 ls_name = Trim(ds_data.Fields("kcwpmc").Value) '"修改后名称" '物料名称 ls_type = "02" 'U(ds_data.Fields("kccwlb").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" '是否生产耗用 '增加文件头相关信息 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 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 ls_temp As String '接收返回消息,如果成功,返回U8中物料代码,如果失败,返回错误信息 If SendToEAI(ls_xml, ls_temp) Then '成功 xml_inventory = True Else '失败 ' MsgBox ls_temp End If End Function