VBA to open MM_TEST in folder /subfolder

[MikeL]

Hi ,
I would like to open a file ie MM_Test by DIR or FSO method by searching all folders and subfolders in Directory: C/Example/

The file names can also range from 01_TEST to 12_TEST. For example , latest would currently be 06_TEST based on June.

So rather than date modified, is there a VBA solution to opening up the latest MM file by going thru all folders/subfolders in directory C/Example/



Thanks in advance.

 

[Leith Ross]

Hello MikeL,

Add a Standard VBA Module to your workbook's VBA project. Copy the macro code code and paste it into the module. Since you did not specify the file type you wanted to open, I included an API call to open any file type that is registered on your computer. The main folder and all of it's subdirectories will be searched for file names having 3 numbers at the start, and underscore, and the TEST (case is ignored). Once the latest file is found, that is the one with the highest number prefix, the macro will open it.

Macro Code

Private FileMonth   As Integer
Private LatestFile  As Variant
Private Subfolders  As Collection


Private Declare PtrSafe Function ShellExecute _
    Lib "Shell32.dll" Alias "ShellExecuteA" _
        (ByVal hwnd As LongPtr, _
         ByVal lpOperation As String, _
         ByVal lpFile As String, _
         ByVal lpParameters As String, _
         ByVal lpDirectory As String, _
         ByVal nShowCmd As Long) _
    As LongPtr
    
Sub OpenLatestFile(ByVal Folder_Path As String, Optional ByVal Include_Subfolders As Boolean)


    Dim FileName    As String
    Dim FilePath    As String
    Dim FileSpec    As String
    Dim Prefix      As Integer
    Dim SubFolder   As Variant
        
        If Subfolders Is Nothing Then Set Subfolders = New Collection
    
        FilePath = IIf(Right(Folder_Path, 1) <> "\", Folder_Path & "\", Folder_Path)
        
        On Error Resume Next
            FileName = Dir(FilePath & "*.*", vbDirectory)
            If Err <> 0 Then GoTo NextFolder
        On Error GoTo 0
        
        Do While FileName <> ""
            FileSpec = FilePath & FileName
            
            On Error Resume Next
                If FileName <> "." And FileName <> ".." And Include_Subfolders = True Then
                    If (GetAttr(FileSpec) And vbDirectory) = vbDirectory Then
                        If Include_Subfolders = True Then Subfolders.Add FileSpec
                    End If
                End If
                
                If UCase(FileName) Like "##_TEST.*" Then
                    Prefix = CInt(Val(Left(FileName, 2)))
                    If Prefix > FileMonth Then
                        FileMonth = Prefix
                        LatestFile = """" & FilePath & FileName & """"
                    End If
                End If
            On Error GoTo 0
         
            FileName = Dir()
        Loop
                
NextFolder:
        If Include_Subfolders And Subfolders.Count <> 0 Then
            SubFolder = Subfolders.Item(1)
            Subfolders.Remove 1
            Call OpenLatestFile(SubFolder, True)
        Else
            If LatestFile <> "" Then
                ShellExecute 0&, "open", LatestFile, vbNullString, vbNullString, vbNormalFocus
            End If
        End If
      
End Sub

Example of Calling the Macro

Sub ListFilesTest()

    OpenLatestFile "C:\Example", True
    
End Sub