Macro create folder based on created date for all of files in directory

[abdelfattah]

hello

I have many files in directory C:\sales , contains many files . so what I want arranging the files by create multiple folders based on created date for all of files . for instance if i have some files created in month JAN then should create folder's name is SALES-JAN-2022 and move the files created date in month JAN to created new folder SALES-JAN-2022 and if the files created in month FEB then should create folder's name is SALES-FEB-2022 and move the files created date in month FEB to created new folder SALES-FEB-2022 . this should happen for each year .

thanks

 

[sarathc]

Hopefully this resolves the problem : You can just change 'MyFolPath' and everything else as same.

Sub MoveMonthlyFilesToRespectiveFolders()
Sheets.Add.Name = "FileNames"
Sheets("FileNames").Activate
MyFolPath = "C:\sales"
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim i As Integer
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(MyFolPath)
For Each oFile In oFolder.Files
    Cells(i + 1, 1) = oFile.Name
    Cells(i + 1, 2) = FileDateTime(oFolder & "\" & oFile.Name)
    Cells(i + 1, 3) = MonthName(Month(Cells(i + 1, 2))) & "_" & Year(Cells(i + 1, 2))
    i = i + 1
Next oFile
Range("C1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("D1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("$D$1:$D$1048576").RemoveDuplicates Columns:=1, Header:=xlNo
i = 1
Do While Cells(i, 4) <> "" 'Loop through to create folders
    MkDir MyFolPath & "\" & Cells(i, 4).Value
    i = i + 1
Loop
i = 1
Dim FSO As Object
Dim SourceFileName As String, DestinFileName As String
Set FSO = CreateObject("Scripting.Filesystemobject")
Do While Cells(i, 1) <> "" 'Loop through to move files
    SourceFileName = MyFolPath & "\" & Sheets("FileNames").Cells(i, 1).Value
    DestinFileName = MyFolPath & "\" & Cells(i, 3).Value & "\" & Sheets("FileNames").Cells(i, 1).Value
    FSO.MoveFile Source:=SourceFileName, Destination:=DestinFileName
    i = i + 1
Loop
End Sub

Let me know if you are finding any issues.

 

[abdelfattah]

gives error application defined error in this line

Sheets.Add.Name = "FileNames"

 

[sarathc]

Make sure there are no sheets named "FileNames" in your excel file.

 

[abdelfattah]

without any doubt . did you test it?