[VBA] - Check for latest report folder within a directory.

[RockandGrohl]

Hello all,

We have a folder for a customer with reporting folders inside, so typically each customer folder will look like this:

2020-12
2021-01
2021-02
2021-03
2021-04
etc
2021-07
2021-08
[other folders]
[other files]

What I want to do is to get the latest dated folder that has the YYYY-MM format, ignoring all other files and folders.

So once that is found, it can be added to a string to open that particular folder like:

Company\Customers\Donk\2021-08\

I'd then want to open any xls file that had the name "Usage" in it.

Thanks guys!

 

[GWteB]

What I want to do is to get the latest dated folder

Do you mean according its name or according its date-time stamp?

 

[RockandGrohl]

Do you mean according its name or according its date-time stamp?

It's name

Thanks

 

[GWteB]

Right, how about the code below. Note the separate function procedures. They are necessary to make this all happen.

Public Sub RockandGrohl()

    Const SEARCHFOLDER As String = "C:\Users\RockandGrohl\Company\Customers\Donk"       ' <<< change to suit
    Const SEARCHFORMAT As String = "####-##"

    Dim FullName As String
    FullName = GetFirstFolderByFormat(SEARCHFOLDER, SEARCHFORMAT, xlDescending)

End Sub


Public Function GetFirstFolderByFormat(ByVal argSearchFolder As String, ByVal argFormat As String, Optional ByVal argSortOrder As XlSortOrder = xlAscending) As String

    Dim FSO As Object, oFolder As Object, Dict As Object
    Dim FolderName  As String, i As Long

    If Len(argSearchFolder) > 0 And Len(argFormat) > 0 Then
        argSearchFolder = IIf(Right(argSearchFolder, 1) = "\", argSearchFolder, argSearchFolder & "\")
        Set FSO = CreateObject("Scripting.FileSystemObject")
        If FSO.FolderExists(argSearchFolder) Then

            Set Dict = CreateObject("Scripting.Dictionary")
            For Each oFolder In FSO.GetFolder(argSearchFolder).SubFolders
                Dict.Add oFolder.Name, oFolder.DateCreated
            Next oFolder
            Set Dict = DictSortByKey(Dict, argSortOrder)

            For i = 0 To Dict.Count - 1
                If Dict.Keys()(i) Like argFormat Then
                    GetFirstFolderByFormat = argSearchFolder & Dict.Keys()(i)
                    Exit For
                End If
            Next i
        End If
    End If
    Set oFolder = Nothing
    Set FSO = Nothing
    Set Dict = Nothing
End Function


Public Function DictSortByKey(ByVal argDict As Object, Optional ByVal argSortOrder As XlSortOrder = xlAscending) As Object

    Dim oArrList As Object, Dict As Object, Key As Variant

    Set Dict = CreateObject("Scripting.Dictionary")
    Set oArrList = CreateObject("System.Collections.ArrayList")

    For Each Key In argDict.Keys
        oArrList.Add Key
    Next Key
    oArrList.Sort
    If argSortOrder = xlDescending Then
        oArrList.Reverse
    End If
    For Each Key In oArrList
        Dict.Add Key, argDict(Key)
    Next Key
    Set DictSortByKey = Dict

    Set oArrList = Nothing
    Set Dict = Nothing
End Function

 

[Akuini]

Another option:
Just to get the latest dated folder (result in immediate window).

Sub GetSubFolderNames_1180678()
Dim FileName As String
Dim PathName As String
Dim tx As String
PathName = "D:\zzz\try\"  '< --adjust
FileName = Dir(PathName, vbDirectory)

Do While FileName <> ""
    If GetAttr(PathName & FileName) = vbDirectory And FileName Like "####-##" Then tx = FileName
    FileName = Dir()
Loop

Debug.Print tx

End Sub

 

[RockandGrohl]

Right, how about the code below. Note the separate function procedures. They are necessary to make this all happen.

Public Sub RockandGrohl()

    Const SEARCHFOLDER As String = "C:\Users\RockandGrohl\Company\Customers\Donk"       ' <<< change to suit
    Const SEARCHFORMAT As String = "####-##"

    Dim FullName As String
    FullName = GetFirstFolderByFormat(SEARCHFOLDER, SEARCHFORMAT, xlDescending)

End Sub


Public Function GetFirstFolderByFormat(ByVal argSearchFolder As String, ByVal argFormat As String, Optional ByVal argSortOrder As XlSortOrder = xlAscending) As String

    Dim FSO As Object, oFolder As Object, Dict As Object
    Dim FolderName  As String, i As Long

    If Len(argSearchFolder) > 0 And Len(argFormat) > 0 Then
        argSearchFolder = IIf(Right(argSearchFolder, 1) = "\", argSearchFolder, argSearchFolder & "\")
        Set FSO = CreateObject("Scripting.FileSystemObject")
        If FSO.FolderExists(argSearchFolder) Then

            Set Dict = CreateObject("Scripting.Dictionary")
            For Each oFolder In FSO.GetFolder(argSearchFolder).SubFolders
                Dict.Add oFolder.Name, oFolder.DateCreated
            Next oFolder
            Set Dict = DictSortByKey(Dict, argSortOrder)

            For i = 0 To Dict.Count - 1
                If Dict.Keys()(i) Like argFormat Then
                    GetFirstFolderByFormat = argSearchFolder & Dict.Keys()(i)
                    Exit For
                End If
            Next i
        End If
    End If
    Set oFolder = Nothing
    Set FSO = Nothing
    Set Dict = Nothing
End Function


Public Function DictSortByKey(ByVal argDict As Object, Optional ByVal argSortOrder As XlSortOrder = xlAscending) As Object

    Dim oArrList As Object, Dict As Object, Key As Variant

    Set Dict = CreateObject("Scripting.Dictionary")
    Set oArrList = CreateObject("System.Collections.ArrayList")

    For Each Key In argDict.Keys
        oArrList.Add Key
    Next Key
    oArrList.Sort
    If argSortOrder = xlDescending Then
        oArrList.Reverse
    End If
    For Each Key In oArrList
        Dict.Add Key, argDict(Key)
    Next Key
    Set DictSortByKey = Dict

    Set oArrList = Nothing
    Set Dict = Nothing
End Function

Good lord that's a lot of code.

I'm about to jump on a call but I'll give it a go after, thanks.

 

[RockandGrohl]

Another option:
Just to get the latest dated folder (result in immediate window).

Sub GetSubFolderNames_1180678()
Dim FileName As String
Dim PathName As String
Dim tx As String
PathName = "D:\zzz\try\"  '< --adjust
FileName = Dir(PathName, vbDirectory)

Do While FileName <> ""
    If GetAttr(PathName & FileName) = vbDirectory And FileName Like "####-##" Then tx = FileName
    FileName = Dir()
Loop

Debug.Print tx

End Sub

How would this know that 2021-08 is later than 2021-03 for instance?

What if contents of 2021-03 were modified afterward?

Thanks.

 

[GWteB]

@Akuini, your code gives me an empty string. This can be explained by the fact that a file attribute usually consists of multiple attributes. We need to isolate the attribute we're checking from all the others. If you replace the = character by the AND operater you're close. Close, because my next remark would be the same as RockandGrohl's observation in hist post #7.

 

[RockandGrohl]

I just checked Ak's and his gave me the correct folder, but that was because it was also made AFTER the 2021-07. I'm going to create a new folder called 2021-10 and then another one called 2021-09 and see what happens.

EDIT: Yeah, it works. I created 2021-10 first, then 2021-09 and it gave me 2021-10 as the result.

No offense GWteb, but AK's is fast & compact Easy for my pigeon brain to decipher.

 

[GWteB]

No offense GWteb, but AK's is fast & compact

Don't worry, if you are happy, so am I.

@Akuini's alternative works for now, but only on the basis of coincidences. This has to do with how the NTFS file system works.
In any case, change the = with the AND operator because once your folder has been indexed, @Akuini's code won't work anymore.