open 3 files from folder by date - vba

I want to open 3 files from folder by date in corel draw. I found one macro and modify but open only one file
Sub openLastModified()
Dim folderPath As String, tableName As String, latestTblName As String
Dim modifiedDate As Date
folderPath = "C:\test\"
tableName = Dir(folderPath & "*.cdr")
Do While tableName <> vbNullString
modifiedDate = FileDateTime(folderPath & tableName)
If latestModified < modifiedDate Then
latestModified = modifiedDate
latestTblName = tableName
End If
tableName = Dir()
Loop
OpenDocument folderPath & latestTblName
End Sub

It looks like you want to open the three most recently modified files in your C:/test/ directory.
The cleanest way to do that would be to load the filenames and their respective modification dates into arrays, sort them by modification date, and load the three from the bottom of your array. There are other answers on Stack Overflow to help you sort the arrays efficiently.
Unfortunately, VBA doesn't offer any easy built-in sort functions. A slightly less clean method would be to load the filenames and their respective modification dates into a worksheet and then take advantage of Excel's sorting functions, again reading off of the bottom of your sorted range.
Now, if you're only interested in the three most recently modified and will only ever be interested in those three, here's a quick & dirty modification to your existing code:
Sub openLastModified()
Dim folderPath As String, tableName As String, latestTblName(2) As String
Dim modifiedDate As Date
Dim latestModified(2) As Date
folderPath = "C:\test\"
tableName = Dir(folderPath & "*.cdr")
Do While tableName <> vbNullString
Dim i As Long
modifiedDate = FileDateTime(folderPath & tableName)
For i = 0 To 2
' Check if this file's modification date is later than that of each
' in the latestTblName array, starting with the most recent.
If latestModified(i) < modifiedDate Then
Dim j As Long
' Move remaining values down in the array.
For j = 1 To i Step -1
latestModified(j + 1) = latestModified(j)
latestTblName(j + 1) = latestTblName(j)
Next j
' Place the file name & modification date in the arrays.
latestModified(i) = modifiedDate
latestTblName(i) = tableName
Exit For
End If
Next i
tableName = Dir()
Loop
For i = 0 To 2
OpenDocument folderPath & latestTblName(i)
Next i
End Sub

Related

Select a File based on Expected Name

I am trying to open a file based on a name that is only partially complete in VBA. Here is an example:
I want to pull a file with the name: "MMM B2 06222018"
The file will always be located in "C:\Myfile\"
However, these two files are saved in "C:\Myfile\":
"MMM B2 06222018 Updated" - Updated at 10:00
"MMM B2 06222018" - Updated at 9:00
What I want is for the macro to pull the most recently updated file that has the name "MMM B2 06222018" within the file name, but that name may or maynot be the complete name of the file. In this case, the "MMM B2 06222018 Updated" is the file I want pulled because it includes all of the "MMM B2 06222018" name, AND it is the most recently saved file.
FileDateTime(file_path) 'I was thinking of using this to compare the file save times.
'But I can only use this if I have a file name.
What is a good way of analyzing the partial file name?
Thanks!
Function GET_LATEST_FILE(strFolder As String, strWildCardStart As String) As String
Dim d As Date, fld as Object, f As Object
d = DateSerial(1900, 1, 1)
With CreateObject("scripting.filesystemobject")
Set fld = .getfolder(strFolder)
For Each f In fld.Files
If f.Name Like strWildCardStart & "*" Then
If f.datelastmodified > d Then
d = f.datelastmodified
GET_LATEST_FILE = f.Name
End If
End If
Next f
End With
End Function
Use this like so
GET_LATEST_FILE("C:\Workspace\Dummy Data","Sample")
A less powerful way to do this, without FileSystemObject, is to use Dir:
Function GetLatestFile(ByVal FolderName As String, ByVal FileName As String) As String
GetLatestFile = "" 'Default to blank
'Declare variables
Dim sTestFile As String, dTestFile As Date, dLatest As Date
If Right(FolderName, 1) <> "\" Then FolderName = FolderName & "\" 'Add final slash if missing
If Len(FileName) = Len(Replace(FileName, "*", "")) Then FileName = FileName & "*" 'Add wildcard if missing
dLatest = DateSerial(1900, 0, 0) 'Default to 0
sTestFile = Dir(FolderName & sTestFile) 'First file that matches the filename, if any
While Len(sTestFile) > 1 'Loop through all files until we run out
dTestFile = FileDateTime(FolderName & sTestFile) 'Get Created/Modifed Date
If dTestFile > dLatest Then 'If new file is newer
GetLatestFile = sTestFile
dLatest = dTestFile 'Store date
End If
sTestFile = Dir() 'Calling Dir without any arguments gets the next file to match the last filename given
Wend
End Function

Count specific files in folder with excel vba

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
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.
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
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?

Excel VBA user defined function to find images in folder (match excel names to folder names of images)

Currently i am using a function to match image names from excel sheet to image folder, but i want one more thing... that if i save image and forget to add its name in excel then it should show me that i forget to add name.
for example if i save 3 images in image folder
16095_1.jpg,16095_2.jpg,16095_3.jpg
and i add image names in excel sheet as
16095_1.jpg,16095_2.jpg
then it should warn me that i forget one image name in excel cell.
my image name format is - 16095_1.jpg,16095_2.jpg
function i am using is...
Function findimage(Path As String, ImageList As String)
Dim results
Dim x As Long
Dim dc 'double comma
results = Split(ImageList, ",")
If Not Right(Path, 1) = "\" Then Path = Path & "\"
For x = 0 To UBound(results)
results(x) = Len(Dir(Path & results(x))) > 0
Next
dc = InStr(ImageList, ",,")
If dc = 0 Then
findimage = Join(results, ",")
Else
findimage = ("Double_comma")
End If
End Function
This function takes a folder path and a variable number of patterns (See MSDN - Parameter Arrays (Visual Basic)). Using the MSDN - Dir Function to iterates over the file names in the folder path and compares them against the patterns with the MSDN - Like Operator (Visual Basic) to count the number of files that match the patterns.
Usage:
getFileCount("C:\Users\Owner\Pictures",".gif",".png")
getFileCount("C:\Users\Owner\Pictures","*.gif"
getFileCount("C:\Users\Owner\Pictures","apple_.gif","banana_.gif", "orange_##.*")
getFileCount("C:\Users\Owner\Pictures","#####_#.gif")
Function getFileCount(DirPath As String, ParamArray Patterns() As Variant) As Integer
Dim MyFile As String
Dim count As Integer, x As Long
If Not Right(DirPath, 1) = "\" Then DirPath = DirPath & "\"
MyFile = Dir(DirPath, vbDirectory)
Do While MyFile <> ""
For x = 0 To UBound(Patterns)
If MyFile Like Patterns(x) Then
count = count + 1
Exit For
End If
Next
MyFile = Dir()
Loop
getFileCount = count
End Function

VBA code to delete files in a directory that contains specific characters

I need help in a VBA macro that'll delete files in a directory that contains more than 2 "_" and is older than 3 months old, however there are some folders & sub folders in the directory that must not be touched or modified.
E.g, Hi_Thanks_for_your_help or Hi_Thank_You etc.
Const DIR = "x"
Const MAX_AGE = 3 ' Unit: Months
Dim oFSO
Dim aExclude
Sub XLS()
aExclude = Array("x")
Set oFSO = CreateObject("Scripting.FilesystemObject")
deleteFiles oFSO.GetFolder(DIR)
Set oFSO = Nothing
End Sub
'=================================
Function isExclude(sPath)
Dim s, bAns
bAns = False
For Each s In aExclude
If InStr(1, sPath, s, vbTextCompare) = 1 Then
bAns = True
Exit For
End If
Next
isExclude = bAns
End Function
'=================================
Function isOldFile(fFile)
' Old file if "MAX_AGE" months before today is greater than the file modification time
isOldFile = (DateAdd("m", -MAX_AGE, Date) > fFile.DateLastModified)
End Function
This is the furthest i got with a code, what i'm lacking is how to check if a file name consists more than 2 "_" and if so & it's older than 3 months old = delete.
Thanks in advance! Cheers!
Dim pathname As String = ""
If fileNameCount("file_name") And DateDiff("m", NOW(), FileDateTime(pathname)) > 3 Then ' if '_' is more than 2 count and more than 3 months old, then delete
' if true delete file codes starts here
......
End If
Public Function fileNameCount(filename As String) As Boolean
fileNameCount = False
Dim count As Long
Dim temp() As String
temp = Split(filename, "_")
count = UBound(temp, 1)
If (count > 2) Then
fileNameCount = True
End If
End Function
I have written portion of the codes for you, the method fileNameCount will return you true / false for number of counts of '_', I'm using DateDiff to get the difference of the month of the file. Therefore I'm detecting on the both conditions, if both statement are true condition then you should proceed on with your deletion of file codes which I didn't write for that.
What you need to do is
1) Pass in the "file_name" argument which you need to think on how to get the file name
2) Pass in the right pathname of the file
3) Write the code for deletion of files
Anyway, I didn't test out the code so it might have some error(s). Hope this will help what you're trying to do.
To get the amount of "_" in a file, I would use something similar to this:
Dim a
Dim c As Integer
a = Split("File_Name_Here", "_")
c = Ubound(a)
Using this, you know that if the filename gets split into 3 or more substrings, there were 2 "_" in the filename. As for the age of the file, FileDateTime("FilePath") will get you the created date or the last modified date.

Find most recent fileS, return the last x number of files IF made within a minute of each other

The situation I'm in is the following:
I need to return the path of the most recent fileS in a folder. The number of files that I need to return is specified by "numberOfFiles" and is in descending order from most recent.
E.g,
File1.doc - Last modified at 8:42:00 PM
File2.doc - Last modified at 8:43:00 PM
File3.doc - Last modified at 8:44:00 PM
numberOfFiles = 2, should return an array of;
File3.doc's path
File2.doc's path
This much is working, with the code below.
Option Explicit
Sub test()
Dim FileName As String
Dim FileSpec As String
Dim MostRecentFile As String
Dim MostRecentDate As Date
Dim Directory As String
Dim resultArray() As String
Dim groupedArray() As String
Dim fileCounter As Integer
Dim groupedArrayCounter As Integer
Dim resultArrayCounter As Integer
Dim i As Integer
Dim numberOfFiles As Integer: numberOfFiles = 2
Directory = "C:\Test\"
FileSpec = "File*.doc"
If Right(Directory, 1) <> "\" Then Directory = Directory & "\"
fileCounter = 0
FileName = Dir(Directory & FileSpec, 0)
If FileName <> "" Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(Directory & FileName)
Do While FileName <> ""
If FileDateTime(Directory & FileName) > MostRecentDate Then
MostRecentFile = FileName
MostRecentDate = FileDateTime(Directory & FileName)
ReDim Preserve resultArray(fileCounter)
resultArray(fileCounter) = FileName
fileCounter = fileCounter + 1
End If
FileName = Dir()
Loop
End If
groupedArrayCounter = 0
resultArrayCounter = UBound(resultArray)
ReDim groupedArray(numberOfFiles - 1)
For i = numberOfFiles To 1 Step -1
groupedArray(groupedArrayCounter) = resultArray(resultArrayCounter)
groupedArrayCounter = groupedArrayCounter + 1
resultArrayCounter = resultArrayCounter - 1
Next i
MsgBox "Done"
End Sub
One last requirement has been put on at the last minute, and I'm not sure how I can achieve it. While I need to be able to return numberOfFiles amount of the most recent files (which works), I must only do so if the files are modified within 60 seconds or less of each other (This also needs to be done in descending order from the most recent - in this example, File3). For example;
If file 2 is made within 60 seconds of file 3, add it to the final array
If file 1 is made within 60 seconds of file 2, add it to the final array
Etc until there are no more files or we have exceeded numberOfFiles
Help greatly appreciated
Edit:
I know this can be done somehow using DateDiff("s", var1, var2), I'm just not entirely sure how the logic will work going in descending order starting from the uBound of my array