U811.1接口EAI系列之三--采购订单生成--VB语言

采购订单业务，下面是具体代码与参数说明：

下面调用的通用方法在: http://www.cnblogs.com/spring_wang/p/3393147.html

作者：王春天 2013-10-31

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

1.下面是具体代码：

'采购订单生成XML
Public Function xml_purchaseorder(ls_sql1 As String, ls_sql2 As String) As Boolean
    xml_purchaseorder = True
    Dim ls_xml As String
    Dim ls_sender As String
    Dim ls_code As String
    Dim ls_date As String
    Dim ls_vendorcode As String
    Dim ls_deptcode As String
    Dim ls_personcode As String
    Dim ls_purchase_type_code As String
    Dim ls_operation_type_code As String
    Dim ls_address As String
    Dim ls_recsend_type As String
    Dim ls_idiscounttaxtype As String
    Dim ls_currency_name As String
    Dim ls_currency_rate As String
    Dim ls_tax_rate As String
    Dim ls_paycondition_code As String
    Dim ls_traffic_money As String
    Dim ls_bargain As String
    Dim ls_remark As String
    Dim ls_period As String
    Dim ls_maker As String
    Dim i As Long
    Dim ls_data As String
    Dim ll_count As Long
    Dim ds_head As ADODB.Recordset '主表
    Dim ds_detail As ADODB.Recordset '细表
    
    Set ds_head = CWBQuery(ls_sql1, ls_return)
    If ds_head.RecordCount = 0 Then
        MsgBox "未检索到主表数据！"
        Exit Function
    End If
    Set ds_detail = CWBQuery(ls_sql2, ls_return)
    ll_count = ds_detail.RecordCount
    If ll_count = 0 Then
        MsgBox "未检索到细表数据！"
        Exit Function
    End If
    ls_code = ds_head(0) '订单编号
    ls_date = Format(ds_head(1), "0000-00-00") '订单日期
    ls_vendorcode = ds_head(2) '供应商编号
    ls_deptcode = "" '部门编号
    ls_personcode = ds_head(3) '业务员
    ls_purchase_type_code = "" '采购类型编码
    ls_operation_type_code = ds_head(4) '业务类型
    ls_address = "" '到货地址
    ls_recsend_type = "" '运输方式
    ls_idiscounttaxtype = ds_head(5) '扣税类别 (0应税外加,1应税内含)
    ls_currency_name = ds_head(6) '外币名称
    ls_currency_rate = ds_head(7) '汇率
    ls_tax_rate = "" '税率
    ls_paycondition_code = ds_head(8) '付款条件
    ls_traffic_money = "0" '运费
    ls_bargain = "0" '定金
    ls_remark = "" '备注
    ls_period = "" '采购计划期间
    ls_maker = ds_head(9) '制单人
    
    '增加文件头相关信息
    ls_xml = "<?xml version=""1.0"" encoding=""UTF-8""?>" + vbCrLf
    
    ls_xml = ls_xml & "<ufinterface sender=""" & u8_xtm & """ receiver=""u8"" roottag=""purchaseorder"" doc"" proc=""Add"" renewproofno = ""Y"" codeexchanged=""N"" exportneedexch=""N"" display="""" family="""" timestamp="""">" + vbCrLf
    
    '增加文件中数据项信息 header
    ls_xml = ls_xml & "<purchaseorder>" + vbCrLf
    ls_xml = ls_xml & "<header>" + vbCrLf
    ls_xml = ls_xml & "<code>" & ls_code & "</code>" + vbCrLf '订单编号
    ls_xml = ls_xml & "<date>" & ls_date & "</date>" + vbCrLf '订单日期
    ls_xml = ls_xml & "<vendorcode>" & ls_vendorcode & "</vendorcode>" + vbCrLf '供应商编号
    ls_xml = ls_xml & "<deptcode>" & ls_deptcode & "</deptcode>" + vbCrLf '部门编号
    ls_xml = ls_xml & "<personcode>" & ls_personcode & "</personcode>" + vbCrLf '业务员
    ls_xml = ls_xml & "<purchase_type_code>" & ls_purchase_type_code & "</purchase_type_code>" + vbCrLf '采购类型编码
    ls_xml = ls_xml & "<operation_type_code>" & ls_operation_type_code & "</operation_type_code>" + vbCrLf '业务类型
    ls_xml = ls_xml & "<address>" & ls_address & "</address>" + vbCrLf '到货地址
    ls_xml = ls_xml & "<recsend_type>" & ls_recsend_type & "</recsend_type>" + vbCrLf '运输方式
    ls_xml = ls_xml & "<idiscounttaxtype>" & ls_idiscounttaxtype & "</idiscounttaxtype>" + vbCrLf '扣税类别 (0应税外加,1应税内含)
    ls_xml = ls_xml & "<currency_name>" & ls_currency_name & "</currency_name>" + vbCrLf '外币名称
    ls_xml = ls_xml & "<currency_rate>" & ls_currency_rate & "</currency_rate>" + vbCrLf '汇率
    ls_xml = ls_xml & "<tax_rate>" & ls_tax_rate & "</tax_rate>" + vbCrLf '税率
    ls_xml = ls_xml & "<paycondition_code>" & ls_paycondition_code & "</paycondition_code>" + vbCrLf '付款条件
    ls_xml = ls_xml & "<traffic_money>" & ls_traffic_money & "</traffic_money>" + vbCrLf '运费
    ls_xml = ls_xml & "<bargain>" & ls_bargain & "</bargain>" + vbCrLf '定金
    ls_xml = ls_xml & "<remark>" & ls_remark & "</remark>" + vbCrLf '备注
    ls_xml = ls_xml & "<period>" & ls_period & "</period>" + vbCrLf '采购计划期间
    ls_xml = ls_xml & "<maker>" & ls_maker & "</maker>" + vbCrLf '制单人
    ls_xml = ls_xml & "</header>" + vbCrLf
    
     'body
    ls_xml = ls_xml & "<body>" + vbCrLf
    For i = 1 To ll_count
        ls_xml = ls_xml & "<entry>" + vbCrLf
        ls_data = ds_detail(0)
        ls_xml = ls_xml & "<inventorycode>" & ls_data & "</inventorycode>" + vbCrLf '存货编码
        ls_data = ds_detail(1)
        ls_xml = ls_xml & "<checkflag>" & ls_data & "</checkflag>" + vbCrLf '是否检验
        ls_data = ds_detail(2)
        ls_xml = ls_xml & "<unitcode>" & ls_data & "</unitcode>" + vbCrLf '物料单位编码
        ls_data = Str(ds_detail(3))
        ls_xml = ls_xml & "<quantity>" & ls_data & "</quantity>" + vbCrLf '主计量数量
        ls_data = ""
        ls_xml = ls_xml & "<num>" & ls_data & "</num>" + vbCrLf '辅计量数量
        ls_data = ""
        ls_xml = ls_xml & "<quotedprice>" & ls_data & "</quotedprice>" + vbCrLf '报价
        ls_data = Str(ds_detail(4))
        ls_xml = ls_xml & "<price>" & ls_data & "</price>" + vbCrLf '单价（原币，无税）
        ls_data = Str(ds_detail(4))
        ls_xml = ls_xml & "<taxprice>" & ls_data & "</taxprice>" + vbCrLf '含税单价（原币，无税）
        ls_data = Str(ds_detail(5))
        ls_xml = ls_xml & "<money>" & ls_data & "</money>" + vbCrLf '金额（原币，无税）
        ls_data = ""
        ls_xml = ls_xml & "<tax>" & ls_data & "</tax>" + vbCrLf '税额（原币）
        ls_data = Str(ds_detail(5))
        ls_xml = ls_xml & "<sum>" & ls_data & "</sum>" + vbCrLf '价税合计（原币）
        ls_data = ""
        ls_xml = ls_xml & "<natprice>" & ls_data & "</natprice>" + vbCrLf '单价（本币，无税）
        ls_data = ""
        ls_xml = ls_xml & "<natmoney>" & ls_data & "</natmoney>" + vbCrLf '金额（本币，无税）
        ls_data = ""
        ls_xml = ls_xml & "<nattax>" & ls_data & "</nattax>" + vbCrLf '税额（本币）
        ls_data = ""
        ls_xml = ls_xml & "<natsum>" & ls_data & "</natsum>" + vbCrLf '价税合计（本币）
        ls_data = ""
        ls_xml = ls_xml & "<natdiscount>" & ls_data & "</natdiscount>" + vbCrLf '折扣额（本币）
        ls_data = ""
        ls_xml = ls_xml & "<taxrate>" & ls_data & "</taxrate>" + vbCrLf '税率
        ls_data = ""
        ls_xml = ls_xml & "<item_class>" & ls_data & "</item_class>" + vbCrLf '项目大类
        ls_data = ""
        ls_xml = ls_xml & "<item_code>" & ls_data & "</item_code>" + vbCrLf '项目
        ls_data = ""
        ls_xml = ls_xml & "<item_name>" & ls_data & "</item_name>" + vbCrLf '项目名
        ls_data = Format(ds_detail(6), "0000-00-00")
        ls_xml = ls_xml & "<arrivedate>" & ls_data & "</arrivedate>" + vbCrLf '到货日期
        ls_data = ""
        ls_xml = ls_xml & "<btaxcost>" & ls_data & "</btaxcost>" + vbCrLf '价格标准(0无税,1含税）
        ls_xml = ls_xml & "</entry>" + vbCrLf
    Next i
    ls_xml = ls_xml & "</body>" + vbCrLf
    
    '增加文件尾相关信息
    ls_xml = ls_xml & "</purchaseorder>" + vbCrLf
    ls_xml = ls_xml & "</ufinterface>" + vbCrLf
    Dim ls_temp As String '接收返回消息，如果成功，返回U8中采购订单编号，如果失败，返回错误信息
    If SendToEAI(ls_xml, ls_temp) Then '成功
        MsgBox "上传成功" & ls_temp
    Else '失败
        MsgBox ls_temp
        xml_purchaseorder = False
    End If
End Function

2.参数说明：