The average business loses $13.5M per year to ineffective training (per 1,000 employees). Keep ahead of the competition and combine in-person quality with online cost and flexibility by training with Linux Academy.
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
|split worksheet into new worksheets based on changing value in Column A (by means of an Excel VBA)||4||28|
|XML Node Counting in MS Access VBA||4||36|
|Word Personalized Watermarks||5||35|
|VB.net Code to make a TaskPane float in Excel Add-in||2||10|