To Count Specific Tag in XML automatically-CodePudding

I work on XML files everyday, and it requires to check and count Tag available in each XML file whic i am doing it manually. below in the screenshot i have let suppose 12 XML files in a folder, and i open them each on internet explore and search the tag and count how many times it appeared in an XML, ultimately i have more than 300 XML files in which i have to count tag manually everyday, which you know is very time taking.

IS there anyway i can do it automatically please, where if you experts can write a code in VBS where we can define the Source folder path (XML files are saved) and that code should read the Source name and date and then count the tag and displays the output the Excel sheet.

This way i do not have to open the XML files and count things manually. please see below screenshots. Please note i do not have any coding experience.
I shall remain thankful as always.

CodePudding user response：

Option Explicit

Sub process_folder()

    Dim iRow As Long, wb As Workbook, ws As Worksheet, ar
    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)
    ws.UsedRange.Clear
    ws.Range("A1:C1") = Array("Source Name", "Date", "<Date> Tag Count")
    iRow = 1
    
    ' create FSO and regular expression pattern
    Dim FSO As Object, ts As Object, regex As Object, txt As String
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set regex = CreateObject("VBScript.RegExp")
    With regex
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        .Pattern = "<Date>(.*)</Date>"
    End With

    'Opens the folder picker dialog to allow user selection
    Dim myfolder As String, myfile As String, n As Long
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select a folder"
        .Show
        .AllowMultiSelect = False
        If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
            MsgBox "You did not select a folder"
            Exit Sub
        End If
        myfolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
    End With
    
    'Loop through all files in a folder until DIR cannot find anymore
    Application.ScreenUpdating = False
    myfile = Dir(myfolder & "*.xml")
    Do While myfile <> ""
    
        iRow = iRow   1
        ws.Cells(iRow, 1) = myfile
    
        ' open file and read all lines
        Set ts = FSO.openTextfile(myfolder & myfile)
        txt = ts.readall
        ts.Close
                                   
        ' count pattern matches
        Dim m As Object
        If regex.test(txt) Then
            Set m = regex.Execute(txt)
            ws.Cells(iRow, 2) = m(0).submatches(0) ' get date from first match
            ws.Cells(iRow, 3) = m.Count
            
        Else
            ws.Cells(iRow, 2) = "No tags"
            ws.Cells(iRow, 3) = 0
        End If

        myfile = Dir 'DIR gets the next file in the folder
    Loop
    
    ' results
    ws.UsedRange.Columns.AutoFit
    Application.ScreenUpdating = True
    MsgBox iRow - 1 & " files found in " & myfolder, vbInformation

End Sub

CodePudding user response：

Since you do not show any information about the XML nodes structure, only a recursive Sub searching in all nodes and child nodes crosses my mind to solve the issue...

Please, try the next way. It needs a reference to 'Microsoft XML, v6.0':

Sub testCountTags()
   'it needs a reference to 'Microsoft XML, v6.0'
   Dim xmlPath As String, XDoc As Object, N As MSXML2.IXMLDOMNode
   
   xmlPath = ThisWorkbook.Path & "\TesteXML\DelCxl.xml" 'use here your xml full name (this is what I used for testing)
   Set XDoc = New MSXML2.DOMDocument60
   XDoc.Load (xmlPath)
   
   Dim count As Long: count = 0
   Dim strTag As String: strTag = "PartId" 'use here your tag to be counted (case sensitive)
   
   For Each N In XDoc.DocumentElement.ChildNodes
        recursiveTagSearch N, strTag, count
    Next N
    Debug.Print count & " tags named """ & strTag & """"
End Sub

Sub recursiveTagSearch(N As MSXML2.IXMLDOMNode, strTag As String, ByRef count As Long)
    Dim Nd As MSXML2.IXMLDOMNode
    If N.HasChildNodes Then
        For Each Nd In N.ChildNodes
            If Nd.HasChildNodes Then recursiveTagSearch Nd, strTag, count
            If Nd.nodeName = strTag Then count = count   1
        Next Nd
    End If
End Sub