Count specific files in folder with excel vba - vba

Question

I need some help with my excel vba.
First of all let me tell what it should do...
On a network folder there are pdf-files which should be count.
Folders look like this:
X:/Tests/Manufact/Prod_1/Machine/Num/Year/Month/TEST_DDMMYYYY_TIMESTAMP.PDF
X:/Tests/Manufact/Prod_2/Machine/Num/Year/Month/TEST_DDMMYYYY_TIMESTAMP.PDF
X:/Tests/Manufact/Prod_3/Machine/Num/Year/Month/TEST_DDMMYYYY_TIMESTAMP.PDF
Also there is a folder for each year and for each month, where the pdfs are sorted based on their date of creation.
The files counted should be listed in the active sheet as a list with filename and date.
After that I want to count how many pdf-files were created on a specific day between a given time. Should be in a new sheet like
Date - Time-Period 1 (0AM-6AM) - Time Period 2 (6AM-10AM) - Time Period 3 (10AM - 12AM)
01.01.2017 - 12PDFs - 17PDFs - 11PDFs
02.01.2017 - 19PDFs - 21PDFs - 5PDFs
Maybe there is also a way of memory, so the script does not count all the files again which were already listed before? (Cause there are more than 100k pdfs and it's increasing everyday...)
So... I searched a whole week on the internet for solutions, and I found a few, ending me up with this code:
Sub ListFiles()
Const sRoot As String = "X:\Tests\Manufact\"
Dim t As Date
Application.ScreenUpdating = False
With Columns("A:E")
.ClearContents
.Rows(1).Value = Split("File,Date,Day,Time,Size", ",")
End With
t = Timer
NoCursing sRoot
Columns.AutoFit
Application.ScreenUpdating = True
MsgBox Format(Timer - t, "0.0s")
End Sub
Sub NoCursing(ByVal sPath As String)
Const iAttr As Long = vbNormal + vbReadOnly + _
vbHidden + vbSystem + _
vbDirectory
Dim col As Collection
Dim iRow As Long
Dim jAttr As Long
Dim sFile As String
Dim sName As String
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
Set col = New Collection
col.Add sPath
iRow = 1
Do While col.count
sPath = col(1)
sFile = Dir(sPath, iAttr)
Do While Len(sFile)
sName = sPath & sFile
On Error Resume Next
jAttr = GetAttr(sName)
If Err.Number Then
Debug.Print sName
Err.Clear
Else
If jAttr And vbDirectory Then
If Right(sName, 1) <> "." Then col.Add sName & "\"
Else
iRow = iRow + 1
If (iRow And &HFFF) = 0 Then Debug.Print iRow
Rows(iRow).Range("A1:E1").Value = Array(sName, _
FileDateTime(sName), _
FileDateTime(sName), _
FileDateTime(sName), _
FileLen(sName))
End If
End If
sFile = Dir()
Loop
col.Remove 1
Loop
End Sub
What it does is counting ALL files in the directorys (So there is something missing telling it to only count PDFs).
It does list the files in my sheet, I'm happy with that part, but it only lists it. I still need the sorting part, so either only let it count day and time period, or let it count/list everything first and afterwards sort and count only the day and time period from the list (I really don't know which one would be better, maybe there is an easy way and a hard one?)
So if any one has a clue how to do that, please let me know, I'm thankful for any help!
Best Regards - Jan

Answer 1

OK I just worked on a similar project not to long ago. I am going to assume something here and you tell me if anything will break the whole system.
1) We can and are allowed to move .PDF files to a sub folder after we process it, or
2) We can and are allowed to rename (even temporary) .PDF files.
3) If we pass a month we do not need to process it any longer, for example today we are in February of 2017, so we stopped processing January 2017 files.
If we can and are allowed to proceed with these assumptions, then to lessen the double work, once a .PDF is processed it could be either moved to a sub folder called Processed Files within that month's folder, and at the end of the month we can return them back, or renamed by appending it with a special tag say "PrOCed" if that string will never ever appear in the file name, and then we can exclude any files in that new folder or with that tag.
I would suggest that you would simply read all the file names into a worksheet and then use Text-to-Columns to get the date and time of the file creation, plus maybe you can use the FileSystemObject to get that info to, and then simply use the Excel Group feature to get the breakdown by day and hour.
Hope this helps, if you need any code example, let me know.

Answer 2

Here's how I would do it. The following is largely untested
and should really be treated as pseudocode. Besides it's not
clear that I could give a definitive answer as I've had to make too
many assumptions (ie is Num in the directory just 'Num' or is
it a number, how is TIMESTAMP defined, etc).
I'm assuming that your pdfs will be properly filed in the
correct month folder.
Ie, for example, you won't have
say a month '09' in a '10' folder (this would be an error condition). If that's the case then
what I'm proposing should work. Note that I'm also assuming that
the filenames are correct. If not you can add additional error
processing. Right now if I find an error in the filename I simply skip it - but
you'll probably want to have it printed out as mentioned in the
code comments.
The main data structure is a dictionary that should end up having
a day entry (ie key,value) for each day of the month once all the pdfs for that
month have been processed. The key of this dictionary is a 2 digit
string that represents the day from '01' up to '31' (for the months that
have 31 days). The value is a 1 dimensional array of length 3. So a typical
entry could be (20,31,10) which is 20 files for period 1, 31 for period 2 and
10 for period 3.
For each file you process a regular expression that extracts the day and hour only.
I'm assuming that the period hours don't overlap (just makes things easier - ie so
I don't have to bother with minutes). Once that's extracted I then add to
that days array for the correct time period based on the hour I've found.
You should note that I assume if you've gone through all product directories
for a given month you have now all that months files. So with all the month
files you can now print out the period counts on a different worksheet for each
day.
I haven't bothered implementing 'SummarizeFilesForMonth' but this should be
relatively straightforward once everything else has been debugged. This is
the place where you'll iterate through the day keys in the proper order to
print out the period stats. Other than that there shouldn't have to be any
other additional sorting.
Option Explicit
' Gets all files with the required file extension,
' strips off both the path and the extension and
' returns all files as a collection (which might not be
' what you want - ie might want the full path on the 1st sheet)
Function GetFilesWithExt(path As String, fileExt As String) As Collection
Dim coll As New Collection
Dim file As Variant
file = dir(path)
Dim fileStem As String, ext As String
Do While (file <> "")
ext = Right(file, Len(file) - InStrRev(file, "."))
If ext = fileExt Then
fileStem = Right(file, Len(file) - InStrRev(file, "\"))
coll.Add Left(fileStem, Len(file) - 5)
End If
file = dir
Loop
Set GetFilesWithExt = coll
End Function
' Checks whether a directory exists or not
Function pathExists(path As String)
If Len(dir(path, vbDirectory)) = 0 Then
pathExists = False
Else
pathExists = True
End If
End Function
' TEST_DDMMYYYY_TIMESTAMP is the filename being processed
' assuming TIMESTAMP is hr min sec all concatenated with
' no intervening spaces and all are always 2 digits
Sub UpdateDictWithDayFile(ByRef dictForMonth As Variant, file As String)
Dim regEx As New RegExp
' only extracts day and hour - you'll almost certainly
' have to adjust this regular expression to suit your needs
Dim mat As Object
Dim Day As String
Dim Hour As Integer
regEx.Pattern = "TEST_(\d{2})\d{2}\d{4}_(\d{2})\d{2}\d{2}$"
Set mat = regEx.Execute(file)
If mat.Count = 1 Then
Day = mat(0).SubMatches(0) ' day is a string
Hour = CInt(mat(0).SubMatches(1)) ' hour is an integer
Else
' Think about reporting an error here using debug.print
' i.e., the filename isn't in the proper format
' and will not be counted
Exit Sub
End If
If Not dictForMonth.exists(Day) Then
' 1 dimensional array of 3 items; one for each time period
dictForMonth(Day) = Array(0, 0, 0)
End If
Dim periods() As Variant
periods = dictForMonth(Day)
' I'm using unoverlapping hours unlike what's given in your question
Select Case Day
Case Hour <= 6
periods(0) = periods(0) + 1
Case Hour >= 7 And Hour < 10
periods(1) = periods(1) + 1
Case Hour >= 10
periods(2) = periods(2) + 1
Case Else
' Another possible error; report on debug.print
' will not be counted
Exit Sub
End Select
End Sub
Sub SummarizeFilesForMonth(ByRef dictForMonth As Variant)
' This is where you write out the counts
' to the new sheet for the month. Iterate through each
' day of the month in 'dictForMonth' and print
' out each of pdf counts for the individual periods
' stored in the 1 dimensional array of length 3
End Sub
Sub ProcessAllFiles()
' For each day of the month for which there are pdfs
' this dictionary will hold a 1 dimensional array of size 3
' for each
Dim dictForMonth As Object
Dim year As Integer, startYear As Integer, endYear As Integer
Dim month As Integer, startMonth As Integer, endMonth As Integer
Dim prodNum As Integer, startProdNum As Integer, endProdNum As Integer
Dim file As Variant
Dim files As Collection
startYear = 2014
startMonth = 1
endYear = 2017
endMonth = 2
startProdNum = 1
endProdNum = 3
Dim pathstem As String, path As String
pathstem = "D:\Tests\Manufact\Prod_"
Dim ws As Worksheet
Dim row As Integer
Set ws = ThisWorkbook.Sheets("Sheet1")
row = 1
For year = startYear To endYear:
For month = 1 To 12:
Set dictForMonth = CreateObject("Scripting.Dictionary")
For prodNum = startProdNum To endProdNum
If prodNum = endProdNum And year = endYear And month > endMonth Then Exit Sub
path = pathstem & prodNum & "\Machine\Num\" & year & "\" & Format(month, "00") & "\"
If pathExists(path) Then
Set files = GetFilesWithExt(path, "pdf")
For Each file In files:
' Print out file to column 'A' of 'Sheet1'
ws.Cells(row, 1).Value = file
row = row + 1
UpdateDictWithDayFile dictForMonth, CStr(file)
Next
End If
Next prodNum
SummarizeFilesForMonth dictForMonth
Next month
Next year
End Sub

Answer 3

OK Thanks for confirming the limitations Jan
So then the next option is to build a list of file names in a worksheet that have been processed and pass them, for example if you are using a For Each loop to loop through the files, there will be a test to see if the current name of the file is in the list of processed files, skip it otherwise process it and add its name to the list.
3 refers to all the files in a past month. This way we can search for files by date and get new files to process. So all files generated past a certain date (last run date) will be considered new and need to be processed.
Will that work?