CODEWITHSUNDEEP
excelvbaautomation
Salman
Salman

Reputation: 31

To Count Specific Tag in XML automatically

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.

Screenshot1

XML_backend

Output_File

Upvotes: -1

Views: 173

Answers (1)

CDP1802
CDP1802

Reputation: 16267

Option Explicit

Sub process_folder()

    Dim iRow As Long, wb As Workbook, ws As Worksheet
    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
    
    ' Regex to match Source tags
    Dim regexSrc As Object, m As Object
    Set regexSrc = CreateObject("VBScript.RegExp")
    With regexSrc
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        .Pattern = "<Source>(.*)</Source>"
    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
    
        ' open file and read all lines
        Set ts = FSO.openTextfile(myfolder & myfile)
        txt = ts.readall
        ts.Close
        
        ' get source
        If regexSrc.test(txt) Then
            Set m = regexSrc.Execute(txt)
            ws.Cells(iRow, 1) = m(0).submatches(0)
        Else
            ws.Cells(iRow, 1) = "No Source tags"
        End If
                                   
        ' count pattern matches
        If regex.test(txt) Then
            Set m = regex.Execute(txt)
            ws.Cells(iRow, 2) = m(0).submatches(0)
            ws.Cells(iRow, 3) = m.Count
            
        Else
            ws.Cells(iRow, 2) = "No Date 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

Upvotes: 1

Related Questions