.
gint32
Here is the macro and an attached example workbook. You will need to change the paths in the macro to comply with your system. They are all marked with something similar to:
'<< Change path to COPY TO folder <---//////\\\\\\
#1 - This macro will first check to make certain the folder where the files/folders are being COPIED TO is empty. This will prevent errors trying to copy files/folders with the same name. It first will delete all the files/folders
with in COPY TO folder before doing anything else.
#2 - Then the macro reviews the COPY FROM folder and identifies all of the files that are older than TODAY minus 1 day.
#3 - Those identified files are then copied to the COPY TO folder and the files/folders that were just copied are deleted from the COPY FROM folder.
I suspect there is a part of the macro that probably doesn't quite fit the bill for your purposes. If you will advise what part we can edit it and move forward.
This macro will function if your subfolders are one within the other ... or if there are several folders by themselves all sitting separately within the main folder.
I tested and retested this numerous times here. You should not have any issues with it.
Let me know ...
Option Explicit
Sub Clear_All_Files_And_SubFolders_In_Folder()
'Delete all files and subfolders in the TARGET FOLDER
'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\logit\Desktop\Test2" '<< Change path to COPY TO folder <---//////\\\\\\
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
'Now we will get on with the copying process
PerformCopy
End Sub
Sub PerformCopy()
'<< Change path as required. First on left is the COPY FROM folder; the second on RIGHT <---//////\\\\\\
'<< Is the COPY TO folder
CopyFiles "C:\Users\logit\Desktop\Test1" & "\", "C:\Users\logit\Desktop\Test2" & "\"
End Sub
Public Sub CopyFiles(ByVal strPath As String, ByVal strTarget As String)
Dim FSO As Object
Dim FileInFromFolder As Object
Dim FolderInFromFolder As Object
Dim Fdate As Long
Dim intSubFolderStartPos As Long
Dim strFolderName As String
Dim dirStr As String
Dim ToFolder As String
Dim DeleteFile
On Error Resume Next
Set FSO = CreateObject("scripting.filesystemobject")
ToFolder = "C:\Users\logit\Desktop\Test2" '<< Change path as required.This is the COPY TO folder
'First loop through files
For Each FileInFromFolder In FSO.GetFolder(strPath).Files
Fdate = Int(FileInFromFolder.DateLastModified)
If Fdate < Date - 1 Then
FileInFromFolder.Copy strTarget
Kill FileInFromFolder
End If
Next
'Next loop throug folders
For Each FolderInFromFolder In FSO.GetFolder(strPath).subfolders
CopyFiles FolderInFromFolder.Path & "\", strTarget & "\" & strFolderName & "\"
For Each FileInFromFolder In FSO.GetFolder(strPath).Files
Fdate = Int(FileInFromFolder.DateLastModified)
If Fdate < Date - 1 Then
FileInFromFolder.Copy strTarget
End If
Next
Next
'Now delete all empty folder in the FROM Folder
For Each FolderInFromFolder In FSO.GetFolder(strPath).subfolders
RmDir FolderInFromFolder
Next
End Sub