File Organiser

Sub OrganizeFilesByDate()
    Dim sourceFolder As String
    Dim fileName As String
    Dim fileDate As Date
    Dim yearFolder As String
    Dim monthFolder As String
    Dim fso As Object

    Set fso = CreateObject("Scripting.FileSystemObject")
    sourceFolder = InputBox("Enter source folder path:")

    If sourceFolder = "" Then Exit Sub

    fileName = Dir(sourceFolder & "\*.*")

    Do While fileName <> ""
        fileDate = FileDateTime(sourceFolder & "\" & fileName)
        yearFolder = sourceFolder & "\" & Year(fileDate)
        monthFolder = yearFolder & "\" & Format(fileDate, "MM-mmmm")

        ' Create folders if they don't exist
        If Not fso.FolderExists(yearFolder) Then fso.CreateFolder yearFolder
        If Not fso.FolderExists(monthFolder) Then fso.CreateFolder monthFolder

        ' Move file to appropriate folder
        fso.MoveFile sourceFolder & "\" & fileName, monthFolder & "\" & fileName

        fileName = Dir()
    Loop

    MsgBox "Files organised by date!"
End Sub