VB6.0 生成 XML方法

'*************************************************************************

'Function: CreateDeliveryRequestXml

'Desctiption: 創建一份向紙袋排期系統[調度回復貨期]的{請求}的Xml

' 請求格式如下:

' <?xml version="1.0" encoding="UTF-8"?>

' <REQUEST>

' <PARAMDATA>

' <Order ProjectNo="P1000001" Project SONo="S1000001" SO />

' </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