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

D

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

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Sort by date Sort by votes
ddander54 said:
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.
Click to expand...
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
John_w said:
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
Click to expand...
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
ddander54 said:
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?
Click to expand...
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
John_w said:
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.
Click to expand...
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
You must log in or register to reply here.

Similar threads

I
  • Solved
Using InStr to Find Matches Between Columns
Replies
1
Views
940
Farscape2020
F
D
  • Question Question
Finding most recent file name (File1_YYYYMMDD), update and SaveAs for multiple files
Replies
0
Views
1K
ddander54
D
B
  • Question Question
Use partial name to Search and locate newest file within multi layered subfolders
Replies
1
Views
1K
Buffalo13
B
L
  • Question Question
Code works except when power query is used
Replies
0
Views
1K
lisam77
L
M
  • Question Question
Vlookup with Date Changes daily
Replies
5
Views
651
mwalls33
M

Forum statistics

Threads
1,223,970
Messages
6,175,699
Members
452,667
Latest member
vanessavalentino83

Share this page

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