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

Smurphster16

New Member
Joined
Feb 28, 2019
Messages
25
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:

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

Forum statistics

Threads
1,214,587
Messages
6,120,406
Members
448,958
Latest member
Hat4Life

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top