'*************************************************************************
'Function: CreateDeliveryRequestXml
'Desctiption: 創建一份向紙袋排期系統[調度回復貨期]的{請求}的Xml
' 請求格式如下:
' <?xml version="1.0" encoding="UTF-8"?>
' <REQUEST>
' <PARAMDATA>
' <Order ProjectNo="P1000001" ProjectID="1" SONo="S1000001" SOID="1002" />
' </PARAMDATA>
' </REQUEST>
'
'Parameters: strSONO, iSOID, strProjectNo, iProjectID
'
'Return Value: 返回對應的xml文檔
'*************************************************************************
'DATE NAME DESCRIPTION
'-------------------------------------------------------------------------
'2010-09-03 JinHui Ren Function create
'*************************************************************************
Public Function CreateDeliveryRequestXml(ByVal strProjectNo As String _
, ByVal iProjectID As Long _
, ByVal strSONo As String _
, ByVal iSOID As Long) As String
On Error GoTo ErrHandle:
Dim tempdoc As MSXML2.DOMDocument '定義的xml文件變量
Dim EL_curElement As MSXML2.IXMLDOMElement '定義根節點
Dim RootNode As MSXML2.IXMLDOMNode
Dim l_IXMPI As IXMLDOMProcessingInstruction
Dim l_strxml As String '生成的XML文檔String
Dim node_PARAMDATA As MSXML2.IXMLDOMNode 'PARAMDATA節點對像
Dim node_Order As MSXML2.IXMLDOMNode 'Order 節點對像
' Dim XmlAttribute_ProjectNo As IXMLDOMAttribute 'ProjectNo XmlAttribute屬性
' Dim XmlAttribute_ProjectID As IXMLDOMAttribute 'ProjectID XmlAttribute屬性
' Dim XmlAttribute_SONo As IXMLDOMAttribute 'SONo XmlAttribute屬性
' Dim XmlAttribute_SOID As IXMLDOMAttribute 'SOID XmlAttribute屬性
Dim I As Integer '臨時變量
If Len(strProjectNo) = 0 _
Or Len(iProjectID) = 0 _
Or Len(strSONo) = 0 _
Or Len(iSOID) = 0 Then
CreateDeliveryRequestXml = ""
Exit Function
End If
Set tempdoc = New MSXML2.DOMDocument
Set EL_curElement = tempdoc.createElement("REQUEST") '這裡REQUEST作為根接點
Set tempdoc.documentElement = EL_curElement
Set node_PARAMDATA = tempdoc.createNode(MSXML2.NODE_ELEMENT, "PARAMDATA", "") '創建PARAMDATA節點
EL_curElement.appendChild node_PARAMDATA '在REQUEST下加入 PARAMDATA 節點
Set node_Order = tempdoc.createNode(MSXML2.NODE_ELEMENT, "Order", "") '創建 Order 節點
node_PARAMDATA.appendChild node_Order '在 PARAMDATA 下加入 Order 節點
'<<---------創建 Order裡的 Attribute 屬性及設定值--------------
Dim tempAttribute As IXMLDOMElement
Set tempAttribute = node_Order
tempAttribute.setAttribute "ProjectNo", strProjectNo
tempAttribute.setAttribute "ProjectID", CStr(iProjectID)
tempAttribute.setAttribute "SONo", strSONo
tempAttribute.setAttribute "SOID", CStr(iSOID)
' Set XmlAttribute_ProjectNo = tempdoc.createAttribute("ProjectNo")
' XmlAttribute_ProjectNo.Value = strProjectNo
' Set XmlAttribute_ProjectID = tempdoc.createAttribute("ProjectID")
' XmlAttribute_ProjectID.Value = CStr(iProjectID)
' Set XmlAttribute_SONo = tempdoc.createAttribute("SONo")
' XmlAttribute_SONo.Value = strSONO
' Set XmlAttribute_SOID = tempdoc.createAttribute("SOID")
' XmlAttribute_SOID.Value = CStr(iSOID)
'
' node_Order.Attributes(0) = XmlAttribute_ProjectNo
' node_Order.Attributes(0) = XmlAttribute_ProjectID
' node_Order.Attributes(0) = XmlAttribute_SONo
' node_Order.Attributes(0) = XmlAttribute_SOID
'------------------------------------------------------------------->>>
Set l_IXMPI = tempdoc.createProcessingInstruction("xml", "version='1.0' encoding='UTF-8'")
Call tempdoc.InsertBefore(l_IXMPI, tempdoc.childNodes(0))
l_strxml = tempdoc.XML
'測試試一下有無成功生成
'tempdoc.Save ("d:\Test.xml")
CreateDeliveryRequestXml = l_strxml
Exit Function
ErrHandle:
Screen.MousePointer = vbDefault
If Len(objSystem.strErrorFunction) = 0 Then
objSystem.strErrorModule = mc_strModule
objSystem.strErrorFunction = "CreateDeliveryRequestXml"
End If
Err.Raise Err.Number
End Function