How to opening a file in the latest subfolder with Excel VBA

[Cakz Primz]

Dear all,

I have a folder name Punch and subfolder year (2021, 2022 etc), and in subfolder year I have subfolder of month (01. Jan, 02. Feb, 10. Oct etc) and in subfolder month, I have subfolder of date from 1 till 31 (01, 02, 03, 29, 30, 31).
And the file name I need to open is: AXREP.xlsb

Is it possible dynamically opening this file within that nested folder and subfolder.
For the moment the latest year is: 2022, and the latest month is: 10. Oct, and the latest date is 28

C:\Punch\2022\10. Oct\28\AXREP.xlsb

Thank you in advance.
Prima Indonesia

 

[ouvay]

This should open the latest file named AXREP.xlsb

Option Base 1
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
    Dim wkb As Workbook
 
    vntLatestFile = GetLatestFile("C:\Punch\", "*AXREP.xlsb", True)

    If Not IsEmpty(vntLatestFile) Then
        dtmLatestDate = vntLatestFile(1)
        strLatestPath = vntLatestFile(2)
        On Error GoTo ErrHandler
        'On Error Resume Next
        Set wkb = Workbooks.Open(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(1) > dtmLatestDate Then
                    dtmLatestDate = vntSubfolderResult(1)
                    strLatestPath = vntSubfolderResult(2)
                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

 

[Cakz Primz]

Dear ouvay,

Thanks for everything, thank you very, very much.
Your magical code works very well.
Problem solved!

Again, thank you
Prima Indonesia

 

[ouvay]

Thank you for the feedback!

 

[ouvay]

I would like to however mention that the original code isn't mine.. I found it somewhere on the wide wide web and made some changes to suit my needs.. I don't remember the original programmer but credit goes there

 

[Cakz Primz]

Dear

This should open the latest file named AXREP.xlsb

Option Base 1
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
    Dim wkb As Workbook
 
    vntLatestFile = GetLatestFile("C:\Punch\", "*AXREP.xlsb", True)

    If Not IsEmpty(vntLatestFile) Then
        dtmLatestDate = vntLatestFile(1)
        strLatestPath = vntLatestFile(2)
        On Error GoTo ErrHandler
        'On Error Resume Next
        Set wkb = Workbooks.Open(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(1) > dtmLatestDate Then
                    dtmLatestDate = vntSubfolderResult(1)
                    strLatestPath = vntSubfolderResult(2)
                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

Dear ouvay,

How if the workbook is in share folder but I want to insist opening the file as read only, because someone else could opening the same file?
Can I edit your code, and adding "readonly:=true", within your code below:

    If Not IsEmpty(vntLatestFile) Then
        dtmLatestDate = vntLatestFile(1)
        strLatestPath = vntLatestFile(2)
        On Error GoTo ErrHandler
        'On Error Resume Next
        Set wkb = Workbooks.Open(strLatestPath, ReadOnly:=True)
    Else
        MsgBox "No matching files were found.", vbExclamation
    End If

Is the code will working?

Thank you
Prima Indonesia

 

[ouvay]

Hi! Yes that should work without issues I reckon, I won't be at my computer until Monday to confirm that, but I see no reason why that shouldn't work

 

[Cakz Primz]

Dear ouvay,

But still it takes your time, attention and effort to assist me.
And I really appreciate it.

Thank you so much
Prima Indonesia

I would like to however mention that the original code isn't mine.. I found it somewhere on the wide wide web and made some changes to suit my needs.. I don't remember the original programmer but credit goes there

 

[Cakz Primz]

Dear ouvay,

Okay, enjoy your weekend.

Hi! Yes that should work without issues I reckon, I won't be at my computer until Monday to confirm that, but I see no reason why that shouldn't work