Update a list of files in Sheet1 using a partial match and then latest date (formatted YYYYMMDD)

ddander54

Board Regular
Joined
Oct 18, 2012
Messages
97
I have a macro that will send emails to a list of people in Column A (Name) and Column B (Email address) with attachments that are listed in the same row, Column C:Z (FilePath & FileName with extension). This process uses code from Ron DeBruin (Mail a different file(s) to each person in a range) and works great.
My Sheet would look something like this:
Book1
ABCDE
1DD@abc.comC:\FolderA\SubFolder1\TestFile_20221101.xlsxC:\FolderZ\SubFolder1\TestFile2_20221031.xlsxC:\FolderA\SubFolder2\TestFile3_20221103.xlsx
2JJ@abc.comC:\FolderZ\SubFolder1\TestFile2_20221031.xlsxC:\FolderA\SubFolder2\TestFile3_20221103.xlsx
3JJ@abc.comC:\FolderA\SubFolder1\TestFile_20221101.xlsx
4LL@abc.comC:\FolderA\SubFolder2\TestFile3_20221103.xlsx
5TT@abc.com
6KK@abc.com
7DD@abc.com
8BB@abc.com
9RR@abc.com
Sheet1


What I need help with is updating the list of files in Sheet 1 using a partial match on the FilePath/FileName_LatestFile.....with the LatestFile being the one with the most recent date (YYYYMMDD) or latest CreationDate. So if file C:\FolderZ\SubFolder1\TestFile2_20221031.xlsx has a more recent version in the folder/subfolder (ie C:\FolderZ\SubFolder1\TestFile2_20221101.xlsx), then insert that in the cell (C2 in this case). Hope that makes sense.

I have found lots of vba to get all the files in a directory/subdirectory (or partial list by file extension), but nothing where I can update an existing 'list' using a partial match and most recent file. Is this possible?

Thanks,
Don
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
What I need help with is updating the list of files in Sheet 1 using a partial match on the FilePath/FileName_LatestFile.....with the LatestFile being the one with the most recent date (YYYYMMDD) or latest CreationDate. So if file C:\FolderZ\SubFolder1\TestFile2_20221031.xlsx has a more recent version in the folder/subfolder (ie C:\FolderZ\SubFolder1\TestFile2_20221101.xlsx), then insert that in the cell (C2 in this case). Hope that makes sense.
If I've understood you correctly, try this macro in a copy of your workbook.

VBA Code:
Public Sub Update_Sheet_With_Latest_Files()
   
    Dim r As Long, c As Long
   
    With ActiveSheet
        For r = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            For c = 3 To .Cells(r, .Columns.Count).End(xlToLeft).Column
                If Not IsEmpty(.Cells(r, c).Value) Then
                    .Cells(r, c).Value = Get_Latest_File(.Cells(r, c).Value)
                End If
            Next
        Next
    End With
   
    MsgBox "Done"
   
End Sub


Private Function Get_Latest_File(currentFile As String) As String

    Static FSO As Object 'Scripting.FileSystemObject
    Dim FSfolder As Object 'Scripting.Folder
    Dim FSfile As Object 'Scripting.File
    Dim latestCreationDate As Date
    Dim fileNameDate As Date
    Dim p1 As Long, p2 As Long
    Dim currentFilePrefix As String, currentFileExt As String
   
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
   
    Get_Latest_File = ""
   
    p1 = InStrRev(currentFile, "\")
    p2 = InStr(Mid(currentFile, p1 + 1), "_")
    currentFilePrefix = Mid(currentFile, p1 + 1, p2) 'includes "_"
    p2 = InStrRev(currentFile, ".")
    currentFileExt = Mid(currentFile, p2) 'includes "."
       
    Set FSfolder = FSO.GetFolder(Left(currentFile, p1))
   
    latestCreationDate = 0
    For Each FSfile In FSfolder.Files
        If LCase(FSfile.Name) Like LCase(currentFilePrefix & "########" & currentFileExt) Then
            p1 = InStr(FSfile.Name, "_")
            fileNameDate = DateSerial(Mid(FSfile.Name, p1 + 1, 4), Mid(FSfile.Name, p1 + 5, 2), Mid(FSfile.Name, p1 + 7, 2))
            If fileNameDate > latestCreationDate Then
                latestCreationDate = fileNameDate
                Get_Latest_File = FSfile.Path
            End If
            If FSfile.DateCreated > latestCreationDate Then
                latestCreationDate = FSfile.DateCreated
                Get_Latest_File = FSfile.Path
            End If
        End If
    Next
   
End Function
 
Upvote 0
If I've understood you correctly, try this macro in a copy of your workbook.

VBA Code:
Public Sub Update_Sheet_With_Latest_Files()
 
    Dim r As Long, c As Long
 
    With ActiveSheet
        For r = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            For c = 3 To .Cells(r, .Columns.Count).End(xlToLeft).Column
                If Not IsEmpty(.Cells(r, c).Value) Then
                    .Cells(r, c).Value = Get_Latest_File(.Cells(r, c).Value)
                End If
            Next
        Next
    End With
 
    MsgBox "Done"
 
End Sub


Private Function Get_Latest_File(currentFile As String) As String

    Static FSO As Object 'Scripting.FileSystemObject
    Dim FSfolder As Object 'Scripting.Folder
    Dim FSfile As Object 'Scripting.File
    Dim latestCreationDate As Date
    Dim fileNameDate As Date
    Dim p1 As Long, p2 As Long
    Dim currentFilePrefix As String, currentFileExt As String
 
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
 
    Get_Latest_File = ""
 
    p1 = InStrRev(currentFile, "\")
    p2 = InStr(Mid(currentFile, p1 + 1), "_")
    currentFilePrefix = Mid(currentFile, p1 + 1, p2) 'includes "_"
    p2 = InStrRev(currentFile, ".")
    currentFileExt = Mid(currentFile, p2) 'includes "."
     
    Set FSfolder = FSO.GetFolder(Left(currentFile, p1))
 
    latestCreationDate = 0
    For Each FSfile In FSfolder.Files
        If LCase(FSfile.Name) Like LCase(currentFilePrefix & "########" & currentFileExt) Then
            p1 = InStr(FSfile.Name, "_")
            fileNameDate = DateSerial(Mid(FSfile.Name, p1 + 1, 4), Mid(FSfile.Name, p1 + 5, 2), Mid(FSfile.Name, p1 + 7, 2))
            If fileNameDate > latestCreationDate Then
                latestCreationDate = fileNameDate
                Get_Latest_File = FSfile.Path
            End If
            If FSfile.DateCreated > latestCreationDate Then
                latestCreationDate = FSfile.DateCreated
                Get_Latest_File = FSfile.Path
            End If
        End If
    Next
 
End Function
John_w,

Back from the weekend off.......This is amazing and far beyond what I could ever do, so Thank you!
I had a little trouble with it at first, so played 'guess-n-test' until I think I got to the root cause of the problem.....some of my file names have more than 1 underscore in them (one or more). So, a filename like Dir:\Folder\Sub Folder\Dept_Budget_2022_v3_20221104.xlsm is failing by just emptying the cell and moving on to the rest. Is there a way to just look at the last underscore in the file name? Or look at the underscore at the 9th position before the "." (dot) and extension. Or 'any file name' to avoid the multiple underscore issue to begin with?
I do understand you created this with my examples which have '_YYYYMMDD' at the end of the file, which is also my normal naming convention, so you did all I asked for and more. The one condition I didn't provide you was an example with multiple underscores, so my bad.

Thanks again for your time and work on this.

 
Upvote 0
some of my file names have more than 1 underscore in them (one or more). So, a filename like Dir:\Folder\Sub Folder\Dept_Budget_2022_v3_20221104.xlsm is failing by just emptying the cell and moving on to the rest. Is there a way to just look at the last underscore in the file name?
Simply change the two InStr functions, which are looking for the underscore from the start of the file name, to InStrRev to look from the end.
 
Upvote 0
Solution
Simply change the two InStr functions, which are looking for the underscore from the start of the file name, to InStrRev to look from the end.
Posting my finished code with just a couple of simple changes per John_w's direction. Works great!!! Thank you John_w.

VBA Code:
Option Explicit

Public Sub Update_Sheet_With_Latest_Files()
  
    Dim r As Long, c As Long
  
    With ActiveSheet
        For r = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row  ' Originally was r = 2, but there is no header row
            For c = 3 To .Cells(r, .Columns.Count).End(xlToLeft).Column
                If Not IsEmpty(.Cells(r, c).Value) Then
                    .Cells(r, c).Value = Get_Latest_File(.Cells(r, c).Value)
                End If
            Next
        Next
    End With
  
    MsgBox "Done"
  
End Sub


Private Function Get_Latest_File(currentFile As String) As String

    Static FSO As Object 'Scripting.FileSystemObject
    Dim FSfolder As Object 'Scripting.Folder
    Dim FSfile As Object 'Scripting.File
    Dim latestCreationDate As Date
    Dim fileNameDate As Date
    Dim p1 As Long, p2 As Long
    Dim currentFilePrefix As String, currentFileExt As String
  
    If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
  
    Get_Latest_File = ""
  
    p1 = InStrRev(currentFile, "\")
    p2 = InStrRev(Mid(currentFile, p1 + 1), "_")  ' Originally was InStr, removed to resolve the multiple _ in file names
    currentFilePrefix = Mid(currentFile, p1 + 1, p2) 'includes "_"
    p2 = InStrRev(currentFile, ".")
    currentFileExt = Mid(currentFile, p2) 'includes "."
      
    Set FSfolder = FSO.GetFolder(Left(currentFile, p1))
  
    latestCreationDate = 0
    For Each FSfile In FSfolder.Files
        If LCase(FSfile.Name) Like LCase(currentFilePrefix & "########" & currentFileExt) Then
            p1 = InStrRev(FSfile.Name, "_")  ' Originally was InStr, removed to resolve the multiple _ in file names
            fileNameDate = DateSerial(Mid(FSfile.Name, p1 + 1, 4), Mid(FSfile.Name, p1 + 5, 2), Mid(FSfile.Name, p1 + 7, 2))
            If fileNameDate > latestCreationDate Then
                latestCreationDate = fileNameDate
                Get_Latest_File = FSfile.Path
            End If
            If FSfile.DateCreated > latestCreationDate Then
                latestCreationDate = FSfile.DateCreated
                Get_Latest_File = FSfile.Path
            End If
        End If
    Next
  
End Function
 
Upvote 0

Forum statistics

Threads
1,223,248
Messages
6,171,011
Members
452,374
Latest member
keccles

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top