VB6.0 生成 XML方法

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