VBA - Searching within a directory (and it's subfolders) and then opening the latest incarnation of a file

lloydie8

New Member
Joined
Sep 5, 2017
Messages
23
Hi guys

How would I go about writing a VBA script that would essentially search within a directory and it's subfolders (which will always be "H:\Everyone\SOFTCON PCS") and then open the version of a file (which will always be called "EGBCIS13") that corresponds with the current month (based on the file's creation date - i.e if in September, I want to open the file created in September).

I've tried multiple ways and not succeeded!

Please help!

Gareth

 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Can do it like this:

Code:
Public Sub OpenLatestFile()
' Run this procedure to invoke the latest
' file in its default application.

  Dim vntLatestFile As Variant
  Dim strLatestPath As String
  Dim dtmLatestDate As Date
  
  On Error GoTo ErrHandler
  vntLatestFile = GetLatestFile("H:\Everyone\SOFTCON PCS", "EGBCIS13", True)

  If Not IsEmpty(vntLatestFile) Then
    dtmLatestDate = vntLatestFile(0)
    strLatestPath = vntLatestFile(1)
    Call CreateObject("Shell.Application").ShellExecute(strLatestPath)
  Else
    MsgBox "No matching files were found.", vbExclamation
  End If
  
  Exit Sub
ErrHandler:
  MsgBox Err.Description, vbExclamation
End Sub

Private Function GetLatestFile(ByVal strFolderPath As String, _
                      Optional ByVal strFilenamePattern As String = vbNullString, _
                      Optional ByVal blnIncludeSubfolders As Boolean = False) As Variant

' Finds the most recent file in the specified folder, based on date created.
' Can optionally specify a filename pattern, which can use wildcards (such as ?*#).
' Can optionally search subfolders recursively.
' Returns variant array containing date and path of file.
' Returns Empty if no matches are found.

  Dim vntSubfolderResult As Variant
  Dim strLatestPath As String
  Dim dtmLatestDate As Date
  Dim objSubfolder As Object
  Dim objFileSys As Object
  Dim objFolder As Object
  Dim objFile As Object
  
'  On Error GoTo ErrHandler
  Set objFileSys = CreateObject("Scripting.FileSystemObject")
  Set objFolder = objFileSys.GetFolder(strFolderPath)
  dtmLatestDate = CDate(0)
    
  For Each objFile In objFolder.Files
    If UCase(objFile.Name) Like Chr(42) & UCase(strFilenamePattern) & Chr(42) Then
      If objFile.DateCreated > dtmLatestDate Then
        dtmLatestDate = objFile.DateCreated
        strLatestPath = objFile.Path
      End If
    End If
  Next objFile
  
  If blnIncludeSubfolders Then
    For Each objSubfolder In objFolder.SubFolders
      vntSubfolderResult = GetLatestFile(objSubfolder.Path, strFilenamePattern, True)
      If Not IsEmpty(vntSubfolderResult) Then
        If vntSubfolderResult(0) > dtmLatestDate Then
          dtmLatestDate = vntSubfolderResult(0)
          strLatestPath = vntSubfolderResult(1)
        End If
      End If
    Next objSubfolder
  End If
  
  If strLatestPath <> vbNullString Then
    GetLatestFile = Array(dtmLatestDate, strLatestPath)
  Else
    GetLatestFile = Empty
  End If
  
ExitProc:
  Set objSubfolder = Nothing
  Set objFileSys = Nothing
  Set objFolder = Nothing
  Set objFile = Nothing
  Exit Function
  
ErrHandler:
  GetLatestFile = Empty
  Resume ExitProc
End Function
 
Upvote 0
Hi,

I see ParamRay beat me to it. However, I think my version is sufficiently different to be worth posting:
Code:
Sub Demo()
    Dim fso             As Object
    Dim CurrentFile     As String
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    TraverseFolders fso.GetFolder("H:\Everyone\SOFTCON PCS"), "EGBCIS13", CurrentFile
    If CurrentFile <> "" Then MsgBox CurrentFile Else MsgBox "Not Found"
End Sub
Function TraverseFolders(Folder As Variant, Mask As String, CurrentFile As String)
    Dim objFile     As Object
    Dim SubFolder   As Object
    
    For Each objFile In Folder.Files
        If objFile.Name Like Mask And _
            Year(objFile.DateCreated) = Year(Date) And Month( _
            objFile.DateCreated) = Month(Date) Then
                CurrentFile = Folder & "\" & objFile.Name
                Exit Function
        End If
    Next
    For Each SubFolder In Folder.SubFolders
        If CurrentFile <> "" Then Exit Function
        TraverseFolders SubFolder, Mask, CurrentFile
    Next
End Function
Basically, the function TraverseFolders does all the searching and it passes back the file name to the calling macro. If the file has not been found then it returns a null string. So the
Code:
If CurrentFile <> "" Then MsgBox CurrentFile Else MsgBox "Not Found"
line will need to be replaced with your code to process the file.
Note: I search for "EGBCIS13", exactly. You may need to add either a file extension or a wild card to find your file.

Regards,
 
Upvote 0
Thank you so much, this works and opens the file in it's default application.

The file I'm looking for is a text file, but I want to open it within Excel. Is this possible within your script?

Can do it like this:

Code:
Public Sub OpenLatestFile()
' Run this procedure to invoke the latest
' file in its default application.

  Dim vntLatestFile As Variant
  Dim strLatestPath As String
  Dim dtmLatestDate As Date
  
  On Error GoTo ErrHandler
  vntLatestFile = GetLatestFile("H:\Everyone\SOFTCON PCS", "EGBCIS13", True)

  If Not IsEmpty(vntLatestFile) Then
    dtmLatestDate = vntLatestFile(0)
    strLatestPath = vntLatestFile(1)
    Call CreateObject("Shell.Application").ShellExecute(strLatestPath)
  Else
    MsgBox "No matching files were found.", vbExclamation
  End If
  
  Exit Sub
ErrHandler:
  MsgBox Err.Description, vbExclamation
End Sub

Private Function GetLatestFile(ByVal strFolderPath As String, _
                      Optional ByVal strFilenamePattern As String = vbNullString, _
                      Optional ByVal blnIncludeSubfolders As Boolean = False) As Variant

' Finds the most recent file in the specified folder, based on date created.
' Can optionally specify a filename pattern, which can use wildcards (such as ?*#).
' Can optionally search subfolders recursively.
' Returns variant array containing date and path of file.
' Returns Empty if no matches are found.

  Dim vntSubfolderResult As Variant
  Dim strLatestPath As String
  Dim dtmLatestDate As Date
  Dim objSubfolder As Object
  Dim objFileSys As Object
  Dim objFolder As Object
  Dim objFile As Object
  
'  On Error GoTo ErrHandler
  Set objFileSys = CreateObject("Scripting.FileSystemObject")
  Set objFolder = objFileSys.GetFolder(strFolderPath)
  dtmLatestDate = CDate(0)
    
  For Each objFile In objFolder.Files
    If UCase(objFile.Name) Like Chr(42) & UCase(strFilenamePattern) & Chr(42) Then
      If objFile.DateCreated > dtmLatestDate Then
        dtmLatestDate = objFile.DateCreated
        strLatestPath = objFile.Path
      End If
    End If
  Next objFile
  
  If blnIncludeSubfolders Then
    For Each objSubfolder In objFolder.SubFolders
      vntSubfolderResult = GetLatestFile(objSubfolder.Path, strFilenamePattern, True)
      If Not IsEmpty(vntSubfolderResult) Then
        If vntSubfolderResult(0) > dtmLatestDate Then
          dtmLatestDate = vntSubfolderResult(0)
          strLatestPath = vntSubfolderResult(1)
        End If
      End If
    Next objSubfolder
  End If
  
  If strLatestPath <> vbNullString Then
    GetLatestFile = Array(dtmLatestDate, strLatestPath)
  Else
    GetLatestFile = Empty
  End If
  
ExitProc:
  Set objSubfolder = Nothing
  Set objFileSys = Nothing
  Set objFolder = Nothing
  Set objFile = Nothing
  Exit Function
  
ErrHandler:
  GetLatestFile = Empty
  Resume ExitProc
End Function
 
Upvote 0
Hi

Thanks for posting, unfortunately I couldn't get your code to work. It just keeps returning the "No File Found" pop-up. So it sort of works lol!

Hi,

I see ParamRay beat me to it. However, I think my version is sufficiently different to be worth posting:
Code:
Sub Demo()
    Dim fso             As Object
    Dim CurrentFile     As String
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    TraverseFolders fso.GetFolder("H:\Everyone\SOFTCON PCS"), "EGBCIS13", CurrentFile
    If CurrentFile <> "" Then MsgBox CurrentFile Else MsgBox "Not Found"
End Sub
Function TraverseFolders(Folder As Variant, Mask As String, CurrentFile As String)
    Dim objFile     As Object
    Dim SubFolder   As Object
    
    For Each objFile In Folder.Files
        If objFile.Name Like Mask And _
            Year(objFile.DateCreated) = Year(Date) And Month( _
            objFile.DateCreated) = Month(Date) Then
                CurrentFile = Folder & "\" & objFile.Name
                Exit Function
        End If
    Next
    For Each SubFolder In Folder.SubFolders
        If CurrentFile <> "" Then Exit Function
        TraverseFolders SubFolder, Mask, CurrentFile
    Next
End Function
Basically, the function TraverseFolders does all the searching and it passes back the file name to the calling macro. If the file has not been found then it returns a null string. So the
Code:
If CurrentFile <> "" Then MsgBox CurrentFile Else MsgBox "Not Found"
line will need to be replaced with your code to process the file.
Note: I search for "EGBCIS13", exactly. You may need to add either a file extension or a wild card to find your file.

Regards,
 
Upvote 0
Thank you so much, this works and opens the file in it's default application.

The file I'm looking for is a text file, but I want to open it within Excel. Is this possible within your script?

Hello, not at my PC right now, but you would need to delete the entire line containing ShellExecute and replace it with:
Workbooks.Open strLatestPath
 
Upvote 0
Hello, not at my PC right now, but you would need to delete the entire line containing ShellExecute and replace it with:
Workbooks.Open strLatestPath

Also, uncomment the On Error statement - I forgot to do that.
 
Last edited:
Upvote 0
Can do it like this:

Code:
Public Sub OpenLatestFile()
' Run this procedure to invoke the latest
' file in its default application.

  Dim vntLatestFile As Variant
  Dim strLatestPath As String
  Dim dtmLatestDate As Date
 
  On Error GoTo ErrHandler
  vntLatestFile = GetLatestFile("H:\Everyone\SOFTCON PCS", "EGBCIS13", True)

  If Not IsEmpty(vntLatestFile) Then
    dtmLatestDate = vntLatestFile(0)
    strLatestPath = vntLatestFile(1)
    Call CreateObject("Shell.Application").ShellExecute(strLatestPath)
  Else
    MsgBox "No matching files were found.", vbExclamation
  End If
 
  Exit Sub
ErrHandler:
  MsgBox Err.Description, vbExclamation
End Sub

Private Function GetLatestFile(ByVal strFolderPath As String, _
                      Optional ByVal strFilenamePattern As String = vbNullString, _
                      Optional ByVal blnIncludeSubfolders As Boolean = False) As Variant

' Finds the most recent file in the specified folder, based on date created.
' Can optionally specify a filename pattern, which can use wildcards (such as ?*#).
' Can optionally search subfolders recursively.
' Returns variant array containing date and path of file.
' Returns Empty if no matches are found.

  Dim vntSubfolderResult As Variant
  Dim strLatestPath As String
  Dim dtmLatestDate As Date
  Dim objSubfolder As Object
  Dim objFileSys As Object
  Dim objFolder As Object
  Dim objFile As Object
 
'  On Error GoTo ErrHandler
  Set objFileSys = CreateObject("Scripting.FileSystemObject")
  Set objFolder = objFileSys.GetFolder(strFolderPath)
  dtmLatestDate = CDate(0)
   
  For Each objFile In objFolder.Files
    If UCase(objFile.Name) Like Chr(42) & UCase(strFilenamePattern) & Chr(42) Then
      If objFile.DateCreated > dtmLatestDate Then
        dtmLatestDate = objFile.DateCreated
        strLatestPath = objFile.Path
      End If
    End If
  Next objFile
 
  If blnIncludeSubfolders Then
    For Each objSubfolder In objFolder.SubFolders
      vntSubfolderResult = GetLatestFile(objSubfolder.Path, strFilenamePattern, True)
      If Not IsEmpty(vntSubfolderResult) Then
        If vntSubfolderResult(0) > dtmLatestDate Then
          dtmLatestDate = vntSubfolderResult(0)
          strLatestPath = vntSubfolderResult(1)
        End If
      End If
    Next objSubfolder
  End If
 
  If strLatestPath <> vbNullString Then
    GetLatestFile = Array(dtmLatestDate, strLatestPath)
  Else
    GetLatestFile = Empty
  End If
 
ExitProc:
  Set objSubfolder = Nothing
  Set objFileSys = Nothing
  Set objFolder = Nothing
  Set objFile = Nothing
  Exit Function
 
ErrHandler:
  GetLatestFile = Empty
  Resume ExitProc
End Function
Hey ParamRay,

I know this post is super old but was going through it and think it applies to what I need (loosely), but can't figure out how to adapt the code to what I need.
Basically I need the sub to go through every sub folder from a given start point and pull the file name of every applicable file (all applicable file names follow the same pattern of "*DEWS.xlsm").
The main thing that is tripping me up is that I need it to pull every file name that matches, rather than pulling only the first file name that matches the set pattern.

If you have any suggestions or are able to help I would greatly appreciate it, thanks!
 
Upvote 0

Forum statistics

Threads
1,223,897
Messages
6,175,269
Members
452,628
Latest member
dd2

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