469,125 Members | 1,638 Online
Bytes | Developer Community
New Post

Home Posts Topics Members FAQ

Post your question to a community of 469,125 developers. It's quick & easy.

Deleting subfolders older than 30 days in the main Folder

14
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
Dec 26 '15 #1
12 1449
hvsummer
215 128KB
@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:
Expand|Select|Wrap|Line Numbers
  1. kill "fullpathhere"
  2.  
to rename or move folder/files you can use
Expand|Select|Wrap|Line Numbers
  1. Name firstPathName SecondPathName
  2.  
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
Expand|Select|Wrap|Line Numbers
  1. Dir("Path")
  2.  
to know whichone is "older than 30 days"
go search google the property Time modify of folder
then you can use
Expand|Select|Wrap|Line Numbers
  1. dim DeathDate as integer
  2.  
  3. DeathDate = Day(Now()) - day(Time modify of folder) 
  4. if deathDate >=30 then
  5.   'code to kill/rename/move subfolder
  6. end if
  7.  
and you have to loop all thing inside main folder.
Expand|Select|Wrap|Line Numbers
  1. for i = 1 to MaxItemInFolder
  2.   'Code to determine which subfolder can be delete having deathDate >=30
  3. Next
  4.  
Dec 26 '15 #2
NeoPa
32,161 Expert Mod 16PB
Good answer, but I believe Kill() will fail if used on any folder that isn't empty.
Dec 27 '15 #3
hvsummer
215 128KB
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
Expand|Select|Wrap|Line Numbers
  1. Sub Clear_All_Files_And_SubFolders_In_Folder()
  2. 'Delete all files and subfolders
  3. 'Be sure that no file is open in the folder
  4.     Dim FSO As Object
  5.     Dim MyPath As String
  6.  
  7.     Set FSO = CreateObject("scripting.filesystemobject")
  8.  
  9.     MyPath = "C:\Users\Ron\Test"  '<< Change
  10.  
  11.     If Right(MyPath, 1) = "\" Then
  12.         MyPath = Left(MyPath, Len(MyPath) - 1)
  13.     End If
  14.  
  15.     If FSO.FolderExists(MyPath) = False Then
  16.         MsgBox MyPath & " doesn't exist"
  17.         Exit Sub
  18.     End If
  19.  
  20.     On Error Resume Next
  21.     'Delete files
  22.     FSO.deletefile MyPath & "\*.*", True
  23.     'Delete subfolders
  24.     FSO.deletefolder MyPath & "\*.*", True
  25.     On Error GoTo 0
  26.  
  27. End Sub
Hishow still need to modify this code with some additional code that I suggest in post #2
Dec 27 '15 #4
zmbd
5,400 Expert Mod 4TB
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.
Dec 27 '15 #5
Hishow
14
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.
Dec 29 '15 #6
hvsummer
215 128KB
@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)
Dec 29 '15 #7
Hishow
14
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.
Dec 29 '15 #8
Hishow
14
Like this:

Expand|Select|Wrap|Line Numbers
  1. Dim strBasePath As String
  2. Dim strFolder As String
  3. Dim strFolderToFind As String
  4.  
  5. strBasePath = "C:\Users\Public\SEP\"
  6. strFolderToFind = "Ade*"
  7.  
  8. strFolder = Dir(strBasePath, vbDirectory)
  9.  
  10. Do While strFolder <> ""    ' Start the loop.
  11.   'Ignore the current directory and the encompassing directory.
  12.     If strFolder <> "." And strFolder <> ".." Then
  13.      'Use bitwise comparison to make sure strFolderToFind is a directory.
  14.        If (GetAttr(strBasePath & strFolder) And vbDirectory) = vbDirectory Then  'a Folder
  15.          If strFolder Like strFolderToFind Then         '1st Criteria met
  16.            If FileDateTime(strBasePath & strFolder) < Now() - 30 Then    '2nd criteria met
  17.              'Debug.Print strBasePath & strFolder
  18.              Kill strBasePath & strFolder & "\*"    'Must Delete Files first
  19.              RmDir strBasePath & strFolder
  20.            End If
  21.          End If
  22.        End If
  23.     End If
  24.     strFolder = Dir    ' Get next entry.
  25. Loop
  26.  
Dec 29 '15 #9
Hishow
14
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.
Dec 29 '15 #10
zmbd
5,400 Expert Mod 4TB
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.
Dec 29 '15 #11
hvsummer
215 128KB
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 ;)
Dec 30 '15 #12
zmbd
5,400 Expert Mod 4TB
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 };-)
Dec 30 '15 #13

Post your reply

Sign in to post your reply or Sign up for a free account.

Similar topics

2 posts views Thread by Meshuggah | last post: by
5 posts views Thread by Meshuggah | last post: by
1 post views Thread by CARIGAR | last post: by
reply views Thread by zhoujie | last post: by
By using this site, you agree to our Privacy Policy and Terms of Use.