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

[lloydie8]

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

 

[ParamRay]

Can do it like this:

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

 

[RickXL]

Hi,

I see ParamRay beat me to it. However, I think my version is sufficiently different to be worth posting:

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

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,

 

[lloydie8]

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:

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

 

[lloydie8]

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:

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

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,

 

[ParamRay]

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

 

[ParamRay]

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.

 

[lloydie8]

Thank you so much, this was exactly what I wanted.

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

 

[ChiefJordan]

Can do it like this:

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!