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
Related
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
I'm trying to check if the file exists in the directory in which the application was saved and if so, to add a number at the end -1, -2. -3 - based on whether a file with the same name already exists. My code is below:
Dim FileName, FilePath As String
Dim FileNumber As Integer
FileName = ProjectName
FilePath = Path.Combine(CurrentDirectory, FileName)
If File.Exists(FilePath) = True Then
Do While File.Exists(FilePath)
FileNumber = FileNumber + 1
FileName = FileName & "-" & FileNumber
FilePath = Path.Combine(CurrentDirectory, FileName)
Loop
End If
NewWorkbook.SaveAs(FilePath)
When I run this code and the file is saving the first time, it works as intended but if I try saving the file with the same name a second time, there is no iterated FileNumber added to it, so the file name stays the same and it cannot save without replacing the original file.
Why is the File.Exists not recognizing that this file already exists and how can I fix this?
There is a logical problem in your code. You continue to modify the same variable and building continuosly new names.
For example. Suppose to have initially a file with the name "Project.vb". At the first iteration inside the loop you check for a file named "Project.vb1", if your loop continues at the second iteration you check for a file named "Project.vb12" and so on.
A more correct way could be
Dim FileName, FileWithoutExtension, FileExtension, FilePath As String
Dim FileNumber As Integer = 1
Dim currentDirectory As String = "E:\temp" ' as an example
FileName = "test.txt" ' as an example
FileExtension = Path.GetExtension(FileName)
FileWithoutExtension = Path.GetFileNameWithoutExtension(FileName)
FilePath = Path.Combine(CurrentDirectory, FileName)
' No need of additional if to test file existance.
Do While File.Exists(FilePath)
FileNumber = FileNumber + 1
' Rebuild the Filename part wtih all the info
FileName = FileWithoutExtension & "-" & FileNumber.ToString("D3") + FileExtension
FilePath = Path.Combine(CurrentDirectory, FileName)
Loop
NewWorkbook.SaveAs(FilePath)
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
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
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.