VBA来自导入xml文件

时间:2018-01-10 13:33:09

标签: xml vba import

来自XML:

<PartNumberList>
<PartNumber PartNumber="DTRxxxxxxxxxxx" Cost="0" Description="Test" Manual="No" Mass="0.216" MountedOnHarness="Yes" PN_Source="WH" PN_Status="OK" PN_Type="Contact" PN_Version="1" Quantity="1" UnitType="Unit" />
</PartNumberList>

我想把DTRxxxxxxxxxxx拉到电子表格中,但每次excel给我最后一个属性“unit”

这是我在vba中的代码部分:

Set xmlNodeListPin = xmldoc.SelectNodes("//ConnectiveDevice[@Tag='" & ForDTRFromTag & "']/PinList/Pin[@Tag='" & ForDTRFromPinTag & "']/*/*/*/PartNumberList/PartNumber[@PartNumber]")
        On Error Resume Next
        For Each xmlNodePin In xmlNodeListPin
            'Debug.Print xmlNode.BaseName
            For Each myAtr In xmlNodePin.Attributes
            'If myAtr.BaseName = "Description" Then pnv = myAtr.Text
                'Debug.Print myAtr.BaseName & ": " & myAtr.Text
                Sheets("WL-test1").Cells(y, x).Value = myAtr.Text
            Next myAtr
            x = x + 1
            myCheck = 0
        Next xmlNodePin
        x = x + myCheck * (UBound(CableFrom) + 1)
        myCheck = 1

有什么想法吗?

生成文档的一些代码

Sub Test()

    Dim oDOC As MSXML2.DOMDocument60
    Set oDOC = New MSXML2.DOMDocument60

    oDOC.LoadXML "<PartNumberList>" & _
        "<PartNumber PartNumber='DTRxxxxxxxxxxx' Cost='0' Description='Test' Manual='No' Mass='0.216' MountedOnHarness='Yes' PN_Source='WH' PN_Status='OK' PN_Type='Contact' PN_Version='1' Quantity='1' UnitType='Unit' />" & _
        "</PartNumberList>"

    Debug.Assert oDOC.parseError.ErrorCode = 0

End Sub

1 个答案:

答案 0 :(得分:0)

你走了。

Option Explicit

Sub Test()

    Dim xmldoc As MSXML2.DOMDocument60
    Set xmldoc = New MSXML2.DOMDocument60

    xmldoc.LoadXML "<ConnectiveDevice Tag='foo'><PinList><Pin Tag='bar'><a><b><c><PartNumberList>" & _
        "<PartNumber PartNumber='DTRxxxxxxxxxxx' Cost='0' Description='Test' Manual='No' Mass='0.216' MountedOnHarness='Yes' PN_Source='WH' PN_Status='OK' PN_Type='Contact' PN_Version='1' Quantity='1' UnitType='Unit' />" & _
        "</PartNumberList></c></b></a></Pin></PinList></ConnectiveDevice>"

    Debug.Assert xmldoc.parseError.ErrorCode = 0

    Dim ForDTRFromTag, ForDTRFromPinTag, y, x, myCheck, CableFrom
    ForDTRFromTag = "foo"
    ForDTRFromPinTag = "bar"

    Dim xmlNodeListPin As MSXML2.IXMLDOMNodeList
    'Set xmlNodeListPin = xmldoc.SelectNodes("//ConnectiveDevice[@Tag='" & ForDTRFromTag & "']/PinList/Pin[@Tag='" & ForDTRFromPinTag & "']/*/*/*/PartNumberList/PartNumber[@PartNumber]")
    Set xmlNodeListPin = xmldoc.SelectNodes("//ConnectiveDevice[@Tag='" & ForDTRFromTag & "']/PinList/Pin[@Tag='" & ForDTRFromPinTag & "']/*/*/*/PartNumberList/PartNumber[@PartNumber]")


    If xmlNodeListPin.Length = 0 Then
        Debug.Print "bad xpath not no nodes found!"
        Stop
    Else
        On Error Resume Next
        Dim xmlNodePin As MSXML2.IXMLDOMNode
        For Each xmlNodePin In xmlNodeListPin
            'Debug.Print xmlNode.BaseName
            Dim myAtr As MSXML2.IXMLDOMAttribute
            For Each myAtr In xmlNodePin.Attributes
                If myAtr.Name = "PartNumber" Then
                'If myAtr.BaseName = "Description" Then pnv = myAtr.Text
                    'Debug.Print myAtr.BaseName & ": " & myAtr.Text
                    'Sheets("WL-test1").Cells(y, x).Value = myAtr.Text

                    Debug.Print myAtr.NodeValue
                End If
            Next myAtr
            x = x + 1
            myCheck = 0
        Next xmlNodePin
        x = x + myCheck * (UBound(CableFrom) + 1)
        myCheck = 1
    End If

    '*****
    '*
    '*   OR with a single line ...
    '*
    '*****
    Dim xmlPartNumber As MSXML2.IXMLDOMAttribute
    Set xmlPartNumber = xmldoc.SelectSingleNode("//ConnectiveDevice[@Tag='" & ForDTRFromTag & "']/PinList/Pin[@Tag='" & ForDTRFromPinTag & "']/*/*/*/PartNumberList/PartNumber/@PartNumber")

    Debug.Print xmlPartNumber.nodeTypedValue


End Sub