Results 1 to 12 of 12
  1. #1
    3 Star Lounger
    Join Date
    Jan 2007
    Location
    Massachusetts, USA
    Posts
    272
    Thanks
    3
    Thanked 0 Times in 0 Posts

    Macro/Script needed to extract certain XML tag (element) data out and put into multicolumn table

    Hi all,

    I am trying to see if there is a script available that can do the following:

    1. Point to a folder full of XML files.
    2. Find each of the following XML elements/tags - in this set of tags: Name, Manufacturer Code, Part Number and Quantity (see sample below)

    -----------------------------------------------------------------------------------------
    <reqSpares>
    <spareDescrGroup>
    <spareDescr id="spa-0001">
    <name>Handlebar</name>
    <identNumber>
    <manufacturerCode>KZ555</manufacturerCode>
    <partAndSerialNumber>
    <partNumber>Hd-001</partNumber>
    </partAndSerialNumber>
    </identNumber>
    <reqQuantity unitOfMeasure="EA">1</reqQuantity>
    </spareDescr>
    </spareDescrGroup>
    </reqSpares>

    ------------------------------------------------------------------------------------

    3. List out all the XML tag (element) tag entries found, and export the data into an MS Word document containing the following columns:

    Name
    Manufacturer Code
    Part Number
    Quantity


    Any ideas on how to make this happen is very much appreciated.


    Regards,

    Jim

  2. #2
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    Try the following macro:
    Code:
    Sub GetXMLData()
    Application.ScreenUpdating = False
    Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
    StrData = "Name" & vbTab & "Manufacturer Code" & vbTab & "Part Number" & vbTab & "Quantity" & vbCr
    strDocNm = ActiveDocument.FullName
    strFolder = GetFolder
    If strFolder = "" Then Exit Sub
    strFile = Dir(strFolder & "\*.xml", vbNormal)
    While strFile <> ""
      If strFolder & "\" & strFile <> strDocNm Then
        Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
        With wdDoc
          With .Range
            With .Find
              .ClearFormatting
              .Replacement.ClearFormatting
              .Text = "\>^13\<name\>*\</reqQuantity\>"
              .Replacement.Text = ""
              .Forward = True
              .Wrap = wdFindStop
              .Format = False
              .MatchWildcards = True
              .Execute
            End With
            Do While .Find.Found
              For i = 1 To UBound(Split(.Text, ">" & vbCr & "<"))
                StrTmp = Split(.Text, ">" & vbCr & "<")(i)
                If InStr(StrTmp, "<") > 0 Then
                  StrData = StrData & Split(Split(StrTmp, "<")(0), ">")(1) & vbTab
                End If
              Next
              StrData = StrData & vbCr
              .Collapse wdCollapseEnd
              .Find.Execute
            Loop
          End With
          .Close SaveChanges:=False
        End With
      End If
      strFile = Dir()
    Wend
    Set wdDoc = Nothing
    StrData = Replace(StrData, vbTab & vbCr, vbCr)
    Set wdDoc = Documents.Add
    With wdDoc.Range
      .Text = StrData
      .ConvertToTable
    End With
    Set wdDoc = Nothing
    Application.ScreenUpdating = True
    End Sub
    
    Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
    End Function
    Note: the code assumes your files have an xml extension; if not, change it in the code.
    Last edited by macropod; 2016-04-14 at 18:52.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  3. #3
    3 Star Lounger
    Join Date
    Jan 2007
    Location
    Massachusetts, USA
    Posts
    272
    Thanks
    3
    Thanked 0 Times in 0 Posts
    Hi Paul,

    Thanks for the reply.

    I tried the script you provided and ran into and error message (see below).


    Compile error:
    Method or data member not found


    .Close SaveChanges:=False


    Any ideas on this particular line in the script?

    Thanks again,

    Jim

  4. #4
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    Code revised. Try it now.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  5. #5
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    james: I see you've asked essentially the same question in http://windowssecrets.com/forums/sho...el-Spreadsheet
    Kindly read Rule #16 - http://windowssecrets.com/forums/faq...ision#flooding
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  6. #6
    3 Star Lounger
    Join Date
    Jan 2007
    Location
    Massachusetts, USA
    Posts
    272
    Thanks
    3
    Thanked 0 Times in 0 Posts
    Hi Paul,

    I was unaware of this rule and can remove the post from the Spreadsheet forum.
    Thanks for making me aware of this rule.

    Regards,

    Jim

  7. #7
    3 Star Lounger
    Join Date
    Jan 2007
    Location
    Massachusetts, USA
    Posts
    272
    Thanks
    3
    Thanked 0 Times in 0 Posts
    Hi Paul,

    I tried it again on a folder full of XML files, and the only thing that got listed on the blank MS Word document, was the header columns for: Name, Manufacturer Code, Part Number and Quantity. So, for some reason, it runs through and completes, but only the table column headings are getting listed.

    Thanks once again.

    Jim

  8. #8
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    Perhaps you could attach a file to a post containing some of the actual data you're trying to process.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  9. #9
    3 Star Lounger
    Join Date
    Jan 2007
    Location
    Massachusetts, USA
    Posts
    272
    Thanks
    3
    Thanked 0 Times in 0 Posts

    Sample file provided

    Hi Paul,

    Here is a generic sample S1000D XML file contained in the sip.

    The sections in the XML file I am looking at right now include:


    <reqSupportEquips>
    <supportEquipDescrGroup>
    <supportEquipDescr id="seq-0001">
    <name>Clean dry cloth</name>
    <identNumber>
    <manufacturerCode>KZ666</manufacturerCode>
    <partAndSerialNumber><partNumber>BSK-TLST-001-12</partNumber></partAndSerialNumber>
    </identNumber>
    <reqQuantity unitOfMeasure="EA">1</reqQuantity>
    </supportEquipDescr>
    <supportEquipDescr>
    <name>Work stand</name>
    <identNumber>
    <manufacturerCode>KZ555</manufacturerCode>
    <partAndSerialNumber><partNumber>Stand-001</partNumber></partAndSerialNumber>
    </identNumber>
    <reqQuantity unitOfMeasure="EA">1</reqQuantity>
    </supportEquipDescr>
    </supportEquipDescrGroup>
    </reqSupportEquips>
    <reqSupplies>
    <supplyDescrGroup>
    <supplyDescr id="sup-0001">
    <name>Rubbing alcohol</name>
    <identNumber>
    <manufacturerCode>KZ222</manufacturerCode>
    <partAndSerialNumber><partNumber>LL-002</partNumber></partAndSerialNumber>
    </identNumber>
    <reqQuantity unitOfMeasure="L">1</reqQuantity>
    </supplyDescr>
    <supplyDescr id="sup-0002">
    <name>General lubricant</name>
    <identNumber>
    <manufacturerCode>KZ222</manufacturerCode>
    <partAndSerialNumber><partNumber>LL-001</partNumber></partAndSerialNumber>
    </identNumber>
    <reqQuantity unitOfMeasure="L">1</reqQuantity>
    </supplyDescr>
    </supplyDescrGroup>
    </reqSupplies>
    <reqSpares>
    <spareDescrGroup>
    <spareDescr id="spa-0002">
    <name>Stem</name>
    <identNumber>
    <manufacturerCode>KZ555</manufacturerCode>
    <partAndSerialNumber><partNumber>St-001</partNumber></partAndSerialNumber>
    </identNumber>
    <reqQuantity unitOfMeasure="EA">1</reqQuantity>
    </spareDescr>
    <spareDescr id="spa-0001">
    <name>Stem bolt</name>
    <identNumber>
    <manufacturerCode>KZ555</manufacturerCode>
    <partAndSerialNumber><partNumber>St-001-01</partNumber></partAndSerialNumber>
    </identNumber>
    <reqQuantity unitOfMeasure="EA">1</reqQuantity>
    </spareDescr>
    </spareDescrGroup>
    </reqSpares>



    Please let me know if you need additional samples and I will be happy to provide.

    Thanks again,

    Jim
    Attached Files Attached Files

  10. #10
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    Because of the way your xml files are encoded, plus the structure being different to what your first post indicated, some changes to the code are required. Try:
    Code:
    Sub GetXMLData()
    Application.ScreenUpdating = False
    Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
    Dim StrTmp As String, StrData As String, i As Long
    StrData = "Name" & vbTab & "Manufacturer Code" & vbTab & "Part Number" & vbTab & "Quantity" & vbCr
    strDocNm = ActiveDocument.FullName
    strFolder = GetFolder
    If strFolder = "" Then Exit Sub
    strFile = Dir(strFolder & "\*.xml", vbNormal)
    While strFile <> ""
      If strFolder & "\" & strFile <> strDocNm Then
        Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, _
          ConfirmConversions:=False, Format:=wdOpenFormatText, Visible:=False)
        With wdDoc
          With .Range
            With .Find
              .ClearFormatting
              .Replacement.ClearFormatting
              .Forward = True
              .Format = False
              .MatchWildcards = False
              .Wrap = wdFindContinue
              .Text = "^p"
              .Replacement.Text = "^p"
              .Execute Replace:=wdReplaceAll
              .Text = "><"
              .Replacement.Text = ">^p<"
              .Execute Replace:=wdReplaceAll
              .MatchWildcards = True
              .Wrap = wdFindStop
              .Text = "\>^13\<name\>*\</reqQuantity\>"
              .Replacement.Text = ""
              .Execute
            End With
            Do While .Find.Found
              For i = 1 To UBound(Split(.Text, ">" & vbCr & "<"))
                StrTmp = Split(.Text, ">" & vbCr & "<")(i)
                If InStr(StrTmp, "<") > 0 Then
                  StrData = StrData & Split(Split(StrTmp, "<")(0), ">")(1) & vbTab
                End If
              Next
              StrData = StrData & vbCr
              .Collapse wdCollapseEnd
              .Find.Execute
            Loop
          End With
          .Close SaveChanges:=False
        End With
      End If
      strFile = Dir()
    Wend
    Set wdDoc = Nothing
    StrData = Replace(StrData, vbTab & vbCr, vbCr)
    Set wdDoc = Documents.Add
    With wdDoc.Range
      .Text = StrData
      .ConvertToTable
    End With
    Set wdDoc = Nothing
    Application.ScreenUpdating = True
    End Sub
    
    Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
    End Function
    Last edited by macropod; 2016-04-17 at 01:03.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

  11. #11
    3 Star Lounger
    Join Date
    Jan 2007
    Location
    Massachusetts, USA
    Posts
    272
    Thanks
    3
    Thanked 0 Times in 0 Posts
    Hi Paul,

    This works great. Thank you for the support.

    Quick question, if I wanted to expand on this macro to include other information, such as the name of each XML file that contains the parts - how would I go about this?

    The Data Module Code (DMC) name is contained within the following XML tags (per the referenced example):

    -------------------------------------------------------------------------------------------------------------------------------------
    <dmAddress>
    <dmIdent><dmCode modelIdentCode="S1000DBIKE" systemDiffCode="AAA" systemCode="DA2" subSystemCode="1" subSubSystemCode="0" assyCode="00" disassyCode="00" disassyCodeVariant="AA" infoCode="720" infoCodeVariant="A" itemLocationCode="A"/> <language countryIsoCode="US" languageIsoCode="en"/>
    <issueInfo issueNumber="007" inWork="00"/>
    </dmIdent><dmAddressItems>
    <issueDate year="2008" month="08" day="01"/><dmTitle>
    <techName>Stem</techName>
    <infoName>Install procedures</infoName>
    </dmTitle>
    </dmAddressItems></dmAddress>

    --------------------------------------------------------------------------------------------------------------------------------------

    DMC-S1000DBIKE-AAA-DA2-10-00-00AA-720A-A_007-00_EN-US.xml (minus the DMC segment) is derived from the tag structure above and in the previous zip.


    If it is too much to make happen in the macro, then no worries - just hoping to also have the reference file, associated with each part listing too.

    Thanks again for the excellent script. Much obliged.

    Jim

  12. #12
    Super Moderator
    Join Date
    May 2002
    Location
    Canberra, Australian Capital Territory, Australia
    Posts
    5,055
    Thanks
    2
    Thanked 417 Times in 346 Posts
    After:
    .MatchWildcards = True
    insert:
    Code:
              .Text = "\<dc:identifier\>*\</dc:identifier\>"
              .Execute
            End With
            StrData = StrData & "Data Module Code: " & Split(Split(.Text, Chr(34))(1), ":")(2) & vbTab & vbTab & vbTab & vbCr
          End With
          With .Range
            With .Find
              .MatchWildcards = True
    and after:
    .ConvertToTable
    insert:
    Code:
      With .Tables(1)
        For i = 2 To .Rows.Count
          If InStr(.Rows(i).Range.Text, "Data Module Code: ") > 0 Then .Rows(i).Cells.Merge
        Next
      End With
    Last edited by macropod; 2016-04-20 at 21:10.
    Cheers,

    Paul Edstein
    [MS MVP - Word]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •