Most precise version to data. (IMO)
Option Explicit Sub Fast_Subfolder_File_Processing() '8-Byte accuracy ' Thanks to all @ http://www.vbaexpress.com/forum/showthread.php?52649-Process-All-CSV-Files-In-SubFolders/page3 Dim Filename As String Dim NameLength As Long Dim FileNames As Variant Dim FileLines As Variant Const F As Long = 5 'CSV field number counting from zero Dim F_Array() As Variant Dim Sum_L As Variant Dim Q_Array() As Variant Dim Sum_Q As Variant Dim C As Variant Dim Pie As Variant Pie = CDec(Application.WorksheetFunction.Pi()) Dim Fn As Long 'Fn = Index number for FileNames Dim CR As Long 'CR = FileLines Index number Dim NumRows As Long Const FolderPath As String = "C:\TestFolder\" 'include ending \ '''' Put all the file names in the path in Array FileNames = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir " & _ FolderPath & "*.csv /b /s").stdout.readall, vbCrLf), ".") '''' Open one file at a time With CreateObject("scripting.filesystemobject") For Fn = 0 To UBound(FileNames) ''''Put all lines from one file in Arrays FileLines = Split(.opentextfile(FileNames(Fn)).readall, vbLf) 'Compensate for extra vbLf's in FileLines Do While FileLines(UBound(FileLines)) = "" ReDim Preserve FileLines(UBound(FileLines) - 1) Loop ReDim F_Array(UBound(FileLines)) ReDim Q_Array(UBound(FileLines)) 'Initialize NumRows = UBound(FileLines) + 1 Sum_L = 0 Sum_Q = 0 ''''Calcuate first result for one file For CR = 0 To UBound(FileLines) 'Replace file line with Log of 6th value. Split(BlahBlah)(5) F_Array(CR) = CDec(Log(Split(FileLines(CR), ",")(F)) / Log(10#)) 'After the first line If CR > 0 Then Sum_L = Sum_L + ((F_Array(CR) - F_Array(CR - 1)) * 100) ^ 2 Q_Array(CR) = Abs((F_Array(CR) - F_Array(CR - 1)) * 100) Sum_Q = Sum_Q + (Q_Array(CR) * Q_Array(CR - 1)) End If Next CR '''' Put results in sheet 'Get FileName NameLength = Len(FileNames(Fn)) - InStrRev(FileNames(Fn), "\") Filename = Right(FileNames(Fn), NameLength) 'Place result With Sheets("Sheet1").Rows(Fn + 1) .Columns(1) = Filename .Columns(2) = Sum_L 'Column B .Columns(3) = (Sum_Q * Pie * (94 / (94 - 1))) / 2 .Columns(4) = NumRows End With Next Fn 'Work on next File End With End Sub Sub Precise_Subfolder_File_Processing() '16-Byte accuracy ' Thanks to all @ http://www.vbaexpress.com/forum/showthread.php?52649-Process-All-CSV-Files-In-SubFolders/page3 Dim Filename As String Dim NameLength As Long Dim FileNames As Variant Dim FileLines As Variant Const F As Long = 5 'CSV field number counting from zero Dim F_Array() As Variant Dim Sum_L As Variant Dim Q_Array() As Variant Dim Sum_Q As Variant Dim Pie As Double Pie = Application.WorksheetFunction.Pi() * 1 Dim Fn As Long 'Fn = Index number for FileNames Dim CR As Long 'CR = FileLines Index number Dim NumRows As Long Const FolderPath As String = "C:\TestFolder\" 'include ending \ '''' Put all the file names in the path in Array FileNames = Filter(Split(CreateObject("wscript.shell").exec("cmd /c Dir " & _ FolderPath & "*.csv /b /s").stdout.readall, vbCrLf), ".") '''' Open one file at a time With CreateObject("scripting.filesystemobject") For Fn = 0 To UBound(FileNames) ''''Put all lines from one file in Arrays FileLines = Split(.opentextfile(FileNames(Fn)).readall, vbLf) 'Compensate for extra vbLf's in FileLines Do While FileLines(UBound(FileLines)) = "" ReDim Preserve FileLines(UBound(FileLines) - 1) Loop ReDim F_Array(UBound(FileLines)) ReDim Q_Array(UBound(FileLines)) 'Initialize NumRows = UBound(FileLines) + 1 Sum_L = 0 Sum_Q = 0 ''''Calcuate first result for one file For CR = 0 To UBound(FileLines) 'Replace file line with Log of 6th value. Split(BlahBlah)(5) F_Array(CR) = Log(Split(FileLines(CR), ",")(F)) / Log(10#) 'After the first line If CR > 0 Then Sum_L = Sum_L + ((F_Array(CR) - F_Array(CR - 1)) * 100) ^ 2 Q_Array(CR) = Abs((F_Array(CR) - F_Array(CR - 1)) * 100) Sum_Q = Sum_Q + (Q_Array(CR) * Q_Array(CR - 1)) End If Next CR '''' Put results in sheet 'Get FileName NameLength = Len(FileNames(Fn)) - InStrRev(FileNames(Fn), "\") Filename = Right(FileNames(Fn), NameLength) 'Place result With Sheets("Sheet1").Rows(Fn + 1) .Columns(1) = Filename .Columns(2) = (Sum_L) .Columns(3) = ((Sum_Q * Pie * (94 / (94 - 1))) / 2) .Columns(4) = NumRows End With Next Fn 'Work on next File End With End Sub




Reply With Quote