Excel VBA Code to pick up the date of the Sub Folder

Smurphster16

New Member
Joined
Feb 28, 2019
Messages
24
Hi Guys,
I have written some excel vba code to try and pick up the latest sub folder within a specific directory, but the code seems to check not only the dates of the subfolders but also the dates of folders outside of the specific directory - the 2 folders before the specified directory and also files within the specified directory - i just want folders

For example if Archive Location = c:\Cars\2019\Used_Cars
CID = c1

Then the code below would also check the last time the following 2 directories were modified as well as any subfolders within my specified directory (c:\Cars\2019\Used_Cars\c1)
1) c:\Cars\2019\Used_Cars
2)c:\Cars\2019\Used_Cars\C1
I only want dates modified of directories WITHIN the specified directory , not the last time the specified directory was modified or the one before (see 1 above)

Thanks in advance!
Phil

VBA Code:
Dim MyPath, MyFile, LatestFile, CID2, Archive_Location, folder_mod_date, Myfolder, FileName, latestfolder As String
Dim Investment_Manager, Investment_Advisor, Custodian, Auditor, Administrator, Jurisdiction, Fund_Structure, PB1, PB2, Fiscal_Year As String
Dim LatestDate, LMD As Date
Dim wb, wb1 As Workbook
Dim FSO As Object

Set FSO = CreateObject("Scripting.FileSystemObject")
Set wb = ActiveWorkbook
CID2 = Sheets("Liquidity_input").Range("CID").Value
Archive_Location = Sheets("control Center").Range("Archive_Location").Value

MyPath = Archive_Location & CID2

    ''Check to see if a directory Exists''
    If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
    Myfolder = Dir(MyPath, vbDirectory)
    If Len(Myfolder) = 0 Then
        MsgBox "No folder were found...", vbExclamation
        Exit Sub
    End If
   
    FileName = Dir(MyPath, vbDirectory)
   
    ''Find Latest sub Folder''
    Do While Len(FileName) > 0
    If GetAttr(MyPath & FileName) = vbDirectory Then
        LMD = FileDateTime(MyPath & FileName)
        If LMD > LatestDate Then
            latestfolder = FileName
            LatestDate = LMD
        End If
    End If
    FileName = Dir()
    Loop


EDIT: Fixed original code
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

Watch MrExcel Video

Forum statistics

Threads
1,118,309
Messages
5,571,468
Members
412,395
Latest member
nielsvanlit
Top