Deleting subfolders older than 30 days in the main Folder

[Hishow]

Dear Experts, please I need help. A vba codes that can delete subfolders older than 30 days in the main Folder. I do not have much experience on vba. Please help me.

Thank you

[hvsummer]

@Hishow:
welcome to Bytes.com
you can't call for the directly code as solution.
we come here to ask how to do that -- not how you guy do that ==

to delete folders in vba you can use:

kill "fullpathhere"
 

to rename or move folder/files you can use

Name firstPathName SecondPathName
 

if the second name is different from first one, file/folder will rename to that name.

you can get information of subfolder, file inside folder with

Dir("Path")
 

to know whichone is "older than 30 days"
go search google the property Time modify of folder
then you can use

dim DeathDate as integer
 
DeathDate = Day(Now()) - day(Time modify of folder) 
if deathDate >=30 then
  'code to kill/rename/move subfolder
end if
 

and you have to loop all thing inside main folder.

for i = 1 to MaxItemInFolder
  'Code to determine which subfolder can be delete having deathDate >=30
Next
 

[NeoPa]

Good answer, but I believe Kill() will fail if used on any folder that isn't empty.

[hvsummer]

I think rondebruin have better example here in this link
Delete files and folders
this code copy from that link that clear everything in main folder without condition >=30 days

Sub Clear_All_Files_And_SubFolders_In_Folder()
'Delete all files and subfolders
'Be sure that no file is open in the folder
    Dim FSO As Object
    Dim MyPath As String
 
    Set FSO = CreateObject("scripting.filesystemobject")
 
    MyPath = "C:\Users\Ron\Test"  '<< Change
 
    If Right(MyPath, 1) = "\" Then
        MyPath = Left(MyPath, Len(MyPath) - 1)
    End If
 
    If FSO.FolderExists(MyPath) = False Then
        MsgBox MyPath & " doesn't exist"
        Exit Sub
    End If
 
    On Error Resume Next
    'Delete files
    FSO.deletefile MyPath & "\*.*", True
    'Delete subfolders
    FSO.deletefolder MyPath & "\*.*", True
    On Error GoTo 0
 
End Sub

Hishow still need to modify this code with some additional code that I suggest in post #2

[zmbd]

actually, if OP had searched here on Bytes the following answer by our own expert ADezii would have turned up:
Find and Delete Directory Folders>Post#4
This code can be easily modified to meet Hishow's requirements and to quote ADezii

What I like about the Code Logic is that there are no External References like File Scripting Runtime, it is all intrinsic.

[Hishow]

Thank you all for helping me. I have tried this from hvsummer even before this request. And also the reference made by zmbd view weeks ago. I didn't get results. Though I would keep trying.

[hvsummer]

@Hishow: can you post your currently code ?
and btw, what error and why you can't get your dream results ?
please give us more detail, we can help you to solve that (most of case, we can solve all problem without limit except limit from hardware or software itself)

[Hishow]

Got it. Thank you so much for all your contributions. And I must say another thank you to zmbd for taking me back to ADezii post 5. My subfolders look like these, Ade2015-12-20, Ade2015-12-21... So I changed line 6 of "Video12*" to "Ade*". And I used my own directory. And it worked perfectly.

May Almighty Allah continue to increase the wisdom and knowledge of all of you.

[Hishow]

Like this:

Dim strBasePath As String
Dim strFolder As String
Dim strFolderToFind As String
 
strBasePath = "C:\Users\Public\SEP\"
strFolderToFind = "Ade*"
 
strFolder = Dir(strBasePath, vbDirectory)
 
Do While strFolder <> ""    ' Start the loop.
  'Ignore the current directory and the encompassing directory.
    If strFolder <> "." And strFolder <> ".." Then
     'Use bitwise comparison to make sure strFolderToFind is a directory.
       If (GetAttr(strBasePath & strFolder) And vbDirectory) = vbDirectory Then  'a Folder
         If strFolder Like strFolderToFind Then         '1st Criteria met
           If FileDateTime(strBasePath & strFolder) < Now() - 30 Then    '2nd criteria met
             'Debug.Print strBasePath & strFolder
             Kill strBasePath & strFolder & "\*"    'Must Delete Files first
             RmDir strBasePath & strFolder
           End If
         End If
       End If
    End If
    strFolder = Dir    ' Get next entry.
Loop
 

[Hishow]

It's actually post 4 of ADezii not post 5. Thank you all for your concern. And also thanks to hvsummer for your much concern.

I am happy.

[zmbd]

line 18/19 could be replaced by
RmDir strBasePath & strFolder & " /s /q"
for windows-xp and newer win-os installations; however, as written, the code is a bit more foolproof against those legacy installs.

[hvsummer]

that RmDIR() similar to DOS command that supprising me ==

didn't know some command like that still valid :D
even the FileDateTime()
and GetAttr()
we can even upgrade code to make it delete or not delete the hidden sub folder :D

it's not really I concern too much, actually I'm interesting in making new code to solve new problem, and will be happy to see new code born by anyone :D I like creative ;)

[zmbd]

most of the old DOS/IBMDOS-IO commands are still valid.
Some like RD/RmDiR have additional functionality in the newer versions of the OS

batch-files good };-)