Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!
Private Sub CommandButton1_Click() Dim strPath As String, strCurrentFile As String Dim MyData As String, strData() As String, strFile As String Dim temp() As String Dim I As Long, LastRow As Long Dim ws As Worksheet '~~> Change the path to the folder where the XML's are stored strPath = "C:\Temp\" Application.ScreenUpdating = False Application.DisplayAlerts = False strCurrentFile = Dir(strPath & "c*.xml") '~~> Loop through the folder to get the xml files Do While strCurrentFile <> "" strFile = strPath & strCurrentFile Set ws = Sheets.Add ws.Name = Replace(strCurrentFile, ".xml", "", , , vbTextCompare) ws.Range("A1") = "File" ws.Range("B1") = "Text" '~~> Open XML as binary for faster reading in one go Open strFile For Binary As #1 MyData = Space$(LOF(1)) Get #1, , MyData Close #1 '~~> Split the data and store it in an array strData() = Split(MyData, vbCrLf) '~~> Get the next available row LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1 '~~> Generate output WITH DUPLICATES For I = 0 To UBound(strData()) If InStr(strData(I), "<node template=") Then temp = Split(strData(I), """") ws.Range("A" & LastRow) = strFile ws.Range("B" & LastRow) = temp(3) LastRow = LastRow + 1 End If Next LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1 '~~> Remove DUPLICATES ws.Range("$A$1:$B$" & LastRow).RemoveDuplicates Columns:=Array(1, 2), Header _ :=xlYes ws.Cells.EntireColumn.AutoFit Application.ScreenUpdating = True Application.DisplayAlerts = True strCurrentFile = Dir Loop End Sub
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Join the community of 500,000 technology professionals and ask your questions.