This script moves and organizes JPEG/JPG files into subdirectories based on the date they were created, and displays a summary of the moved files.

filesorting.vbs

' Set the locale to US English
SetLocale(1033)

Set objArgs = WScript.Arguments

' Check if the number of arguments passed to the script is less than or equal to 1
' If no arguments were passed, display a message and quit the script
If objArgs.Count <= 1 Then
    Wscript.Echo "Enter directory of pictures and target directory"
    WScript.Quit 1
End If

Set FSO = CreateObject("Scripting.FileSystemObject")

' Define variables to represent the source and destination directories
StartFolder = objArgs(0)
ToFolder = objArgs(1)

' If the destination folder path does not end in a slash or backslash, add a backslash
If Not Right(ToFolder, 1) = "/" Or Not Right(ToFolder, 1) = "\" Then
    ToFolder = ToFolder + "\"
End If

' Check if the destination folder exists and create it if it does not
If Not FSO.FolderExists(ToFolder) Then
    FSO.CreateFolder(ToFolder)
End If

Set objFolder = FSO.GetFolder(StartFolder)

' Create an empty dictionary to store file objects
Dim files_lenght
files_lenght = Int(0)
Set files = CreateObject("Scripting.Dictionary")

' Iterate through the files in the source folder and add any JPEG files to the files dictionary
Set filesFromFolder = objFolder.Files
For Each objFile in filesFromFolder
    if Right(objFile, 3) = "jpg" Or Right(objFile, 4) = "jpeg" Then
        files.Add files_lenght, objFile
        files_lenght = files_lenght + 1
    End If
Next

' Call the ShowSubFolders function to iterate through the subfolders of the source folder
' and add any JPEG files to the files dictionary
Wscript.Echo
ShowSubfolders FSO.GetFolder(StartFolder)


Sub ShowSubFolders(Folder)
    For Each Subfolder in Folder.SubFolders
        Set objFolder = FSO.GetFolder(Subfolder.Path)
        Set filesFromFolder = objFolder.Files
        For Each objFile in filesFromFolder
            if Right(objFile, 3) = "jpg" Or Right(objFile, 4) = "jpeg" Then
                files.Add files_lenght, objFile
                files_lenght = files_lenght + 1
            End If
        Next
        Wscript.Echo
        ShowSubFolders Subfolder
    Next
End Sub

' Get the items in the files dictionary
items = files.Items


' Create dictionaries to store the destination folder path and the names of the moved files
Set movedToDirectory = CreateObject("Scripting.Dictionary")
Set movedFileNames = CreateObject("Scripting.Dictionary")

' Iterate through the keys in the files dictionary
For Each key in files.Keys
    ' Get the file object and the date it was created
    Dim item, createdAt, year, indexOfYear, endPoint, absolutepath
    indexOfYear = 0
    item = items(key)
    createdAt = items(key).DateCreated

    ' Check if the date is in a month/day/year format or a day/month/year format
    if InStr(createdAt, "/") Then
        indexOfYear = 2
    End If
    createdAt = Replace(FormatDateTime(createdAt,2),"/","-") 'If different locale'
    year = Split(createdAt, "-")(indexOfYear)

    ' Create a subfolder in the destination folder based on the year the file was created
    if Not FSO.FolderExists(ToFolder+year) Then
        FSO.CreateFolder(ToFolder+year)
    End If

    ' Create a subfolder in the year folder based on the date the file was created
    endPoint = ToFolder+year+"\"+createdAt+"\"
    If Not FSO.FolderExists(endPoint) Then
        FSO.CreateFolder(endPoint)
    End If

    ' Add the destination folder path and the file name to the movedToDirectory and movedFileNames dictionaries
    If Not movedToDirectory.Exists(endPoint) Then
        movedToDirectory.Add endPoint, 1
        movedFileNames.Add endPoint, items(key).Name
    Else
        movedToDirectory(endPoint) = movedToDirectory(endPoint) + 1
        movedFileNames(endPoint) =  movedFileNames(endPoint) + ", " + items(key).Name
    End If

    absolutepath = items(key).Path

    ' Copy the file to the destination folder
    FSO.CopyFile absolutepath, endPoint
Next

' Display a summary of the number of files that were moved and the names of the files that were moved to each destination folder
If files_lenght > 1 Then
    WScript.Echo CStr(files_lenght) + " picture was sorted into " + CStr(movedFileNames.Count) + " folders."
End If

For Each key in movedToDirectory.Keys
    WScript.Echo "-----------------------------"
    Dim movedbyfolder
    movedbyfolder = CStr(movedToDirectory(key))
    if movedbyfolder > 1 Then
        WScript.Echo movedbyfolder + " files"
        WScript.Echo movedFileNames(key)
        WScript.Echo "were moved to folder"
    Else 
        WScript.Echo movedbyfolder + " file"
        WScript.Echo movedFileNames(key)
        WScript.Echo "was moved to folder"
    End If
    WScript.Echo key
Next