[решено] Сортирование файлов по папкам (копирование по дате создания)

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Программное обеспечение Windows (http://forum.oszone.net/forumdisplay.php?f=7)

- - [решено] Сортирование файлов по папкам (копирование по дате создания) (http://forum.oszone.net/showthread.php?t=86094)

DIMM2005

28-06-2007 22:10 605580

Сортирование файлов по папкам (копирование по дате создания)

Подскажите программку (или скрипт какой-то), которая может определить дату создания файла и судя по ней переместить файл в папку с названием "Дата создания файла".

Например:
файл1.jpg - дата создания 3.05.2007

Нужно создать папку 03.05.2007 (или 2007.05.03) и скопировать туда "файл1.jpg".

Пробовал искать по Инету - честно слово, ничего не нашел. А согласитесь, такая программа полезная. У меня фотки с камеры (Canon) когда сливаются на комп сразу по папкам сортируются. А вот на мобильном все файлы в одну папку скидываются и когда на комп перекинешь - то такой бардак

Может тут есть программисты, для которых это не тяжело сделать :) А то я только очень начинающий.

Petya V4sechkin

29-06-2007 12:48 605827

DIMM2005
Можно сделать vbs-скрипт примерно такого содержания:

Код:

Dim FSO, FldN, Fls, Fl, DtN, FlN

Set FSO = WScript.CreateObject("Scripting.FileSystemObject")



If WScript.Arguments.Count = 0 Then

  MsgBox "Не задано имя папки для распределения файлов по датам. ", vbExclamation, "Ошибка"

  WScript.Quit

End If



FldN = WScript.Arguments(0)

If Not FSO.FolderExists(FldN) Then

  MsgBox "Папка """ & FldN & """ не существует. ", vbExclamation, "Ошибка"

  WScript.Quit

End If



Set Fls = FSO.GetFolder(FldN).Files

For Each Fl In Fls

  DtN = FSO.BuildPath(FldN, GetDateName(Fl.DateLastModified))

  If Not FSO.FolderExists(DtN) Then FSO.CreateFolder DtN



  FlN = FSO.BuildPath(DtN, Fl.Name)

  If FSO.FileExists(FlN) Then FSO.DeleteFile FlN, True

  Fl.Move FlN

Next



MsgBox "Скрипт завершен. ", vbInformation, "Финиш"

WScript.Quit



Private Function GetDateName(Dt)

  Dim M, D



  M = Month(Dt)

  D = Day(Dt)

  If M < 10 Then M = "0" & M

  If D < 10 Then D = "0" & D



  GetDateName = Year(Dt) & "-" & M & "-" & D

End Function

Сохранить с расширением .vbs, например DTMove.vbs.
Формат вызова:
DTMove.vbs Имя_папки

P. S. С контролем ошибок не заморачивался, так что использовать аккуратно.

DIMM2005

29-06-2007 18:10 605962

Petya V4sechkin

Спасибо! Все работает, сортирует как надо. Вроде проверял, при разных условиях - все ок... Я как понял скрипт берет дату изменения файла, а не создания, что впринципе мне и нужно. (т.к. при копировании на комп, дата создания меняется, а дата изменения - нет).

Вот только маленький недочет. Скрипт заменяет одинаковые файлы (если имя совпадает и папка назначения). Хотя содержимое файла может быть разным. Я понимаю, в реальной жизни, такое врятли получится, но..... Можно как-то доработать скрипт, что если при сортировании, файл с таким именем уже существует, то переместить его в папку, например "Непонятное". Чтобы я потом посмотрел и лично все досортировал.

Vadikan

29-06-2007 19:30 605999

Petya V4sechkin
Благодарю!

Petya V4sechkin

29-06-2007 19:39 606007

Vadikan
Не за что ;)

DIMM2005

Цитата:

Вот только маленький недочет. Скрипт заменяет одинаковые файлы (если имя совпадает и папка назначения).

Тогда так (с запросом на перезапись):

Код:

Dim FSO, FldN, Fls, Fl, D, DtN, FlN

Set FSO = WScript.CreateObject("Scripting.FileSystemObject")



If WScript.Arguments.Count = 0 Then

  MsgBox "Не задано имя папки для распределения файлов по датам. ", vbExclamation, "Ошибка"

  WScript.Quit

End If



FldN = WScript.Arguments(0)

If Not FSO.FolderExists(FldN) Then

  MsgBox "Папка """ & FldN & """ не существует. ", vbExclamation, "Ошибка"

  WScript.Quit

End If



Set Fls = FSO.GetFolder(FldN).Files

For Each Fl In Fls

  D = GetDateName(Fl.DateLastModified)

  DtN = FSO.BuildPath(FldN, D)

  If Not FSO.FolderExists(DtN) Then FSO.CreateFolder DtN



  FlN = FSO.BuildPath(DtN, Fl.Name)

  If FSO.FileExists(FlN) Then

    If MsgBox("Файл """ & Fl.Name & """ уже существует в папке """ & D & """. " & vbCr & "Перезаписать?", vbQuestion + vbOKCancel, "Внимание") = vbOK Then

      FSO.DeleteFile FlN, True

      Fl.Move FlN

    End If

  Else

    Fl.Move FlN

  End If

Next



MsgBox "Скрипт завершен. ", vbInformation, "Финиш"

WScript.Quit



Private Function GetDateName(Dt)

  Dim M, D



  M = Month(Dt)

  D = Day(Dt)

  If M < 10 Then M = "0" & M

  If D < 10 Then D = "0" & D



  GetDateName = Year(Dt) & "-" & M & "-" & D

End Function

DIMM2005

29-06-2007 21:33 606069

Спасибо! Лучше я бы и не мог придумать.

Petya V4sechkin Можешь толкать как комерческий продукт :) Ведь честно, в Инете ничего подобного не нашел. Только вот "фомат вызова: DTMove.vbs Имя_папки" не все могут понять :) Сегодня наверно тему в сети создам, многим этот скрипт понравится - авторство конечно за тобой :) Это я упомяну...

Petya V4sechkin

29-06-2007 21:57 606085

DIMM2005

Цитата:

Можешь толкать как комерческий продукт :)

Хе-хе, в продукте 40 строчек кода :)

Цитата:

Только вот "фомат вызова: DTMove.vbs Имя_папки" не все могут понять :)

Типа, можно Drug & Drop :) Запускаем Проводник Windows и левой кнопкой мыши кидаем папку на скрипт.
Конечно, лучше было бы сделать, чтобы при отсутствии параметра скрипт спрашивал путь к папке, но я об этом не подумал.

Suprus

18-11-2010 10:09 1545483

Добрый день!
Подскажите как реализовать, сортировку файлов по папкам (по ВРЕМЕНИ создания, не по дате, т.е чтобы скрипт создавал новые папки по формату ЧЧ-ММ и туда сортировал файлы).

Suprus

18-11-2010 12:08 1545575

Вопрос решен.
Может пригодится кому-нибудь..

Код:



Dim FSO, FldN, Fls, Fl, D, DtN, FlN

Set FSO = WScript.CreateObject("Scripting.FileSystemObject")



If WScript.Arguments.Count = 0 Then

  MsgBox "Не задано имя папки для распределения файлов по датам. ", vbExclamation, "Ошибка"

  WScript.Quit

End If



FldN = WScript.Arguments(0)

If Not FSO.FolderExists(FldN) Then

  MsgBox "Папка """ & FldN & """ не существует. ", vbExclamation, "Ошибка"

  WScript.Quit

End If



Set Fls = FSO.GetFolder(FldN).Files

For Each Fl In Fls

  D = GetTimeName(Fl.DateLastModified)

  DtN = FSO.BuildPath(FldN, D)

  If Not FSO.FolderExists(DtN) Then FSO.CreateFolder DtN



  FlN = FSO.BuildPath(DtN, Fl.Name)

  If FSO.FileExists(FlN) Then

    If MsgBox("Файл """ & Fl.Name & """ уже существует в папке """ & D & """. " & vbCr & "Перезаписать?", vbQuestion + vbOKCancel, "Внимание") = vbOK Then

      FSO.DeleteFile FlN, True

      Fl.Move FlN

    End If

  Else

    Fl.Move FlN

  End If

Next



MsgBox "Скрипт завершен. ", vbInformation, "Финиш"

WScript.Quit



Private Function GetTimeName(Dt)

    Dim H, M

    H = Hour(Dt)

    If H < 10 Then H = "0" & H

    M = Minute(Dt)

    If M < 10 Then M = "0" & M

    GetTimeName = CStr(H) & "-" & CStr(M)

End Function

by Petya V4sechkin под редакцией AndVGri, Suprus

cifrovichek

30-10-2011 01:23 1784708

Petya V4sechkin, обращаюсь к Вам за помощью.
Ситуация подобная той, которая описана ТС.
Есть папка с большим кол-вом файлов вида:
ffaa-1.jpg
ffaa-2.jpg
ffaa-3.jpg
ggaa-1.jpg
ggaa-2.jpg
ggaa-3.jpg
Нужно чтобы скрипт создал папку "ffaa" и запихнул в неё файлы ffaa-1.jpg, ffaa-2.jpg и ffaa-3.jpg.
Аналогично со следующей группой файлов.
Это реально ?

Iska	30-10-2011 14:32 1784949

cifrovichek, реально. Откройте командную строку и, перейдя в нужную папку, исполните следующий код:

Код:

for %i in ("E:\Песочница\0088\*.jpg") do @(set sName=%~nxi & (if not exist "!sName:~0,4!" md "!sName:~0,4!") & move "%i" "!sName:~0,4!\")

где: «E:\Песочница\0088\*.jpg» — путь и маска файлов к Вашей «папка с большим кол-вом файлов вида».

Такие вещи проще и надёжнее делать полуавтоматически при помощи файловых менеджеров.

cifrovichek

30-10-2011 20:00 1785204

Цитата:

Цитата Iska

cifrovichek, реально. Откройте командную строку и, перейдя в нужную папку, исполните следующий код: »

Что -то не получается.
Пишет "неверно задано имя папки. Синтаксическая ошибка в имени файла, имени папки или метке тома"
В чём может быть проблема?

Iska	31-10-2011 06:39 1785455

cifrovichek, надеюсь, «E:\Песочница\0088\*.jpg» Вы поменяли на своё? Все файлы «*.jpg» действительно имеют четырёхсимвольную общую часть в именах?

cifrovichek

31-10-2011 12:28 1785606

Цитата:

Цитата Iska

for %i in ("E:\Песочница\0088\*.jpg") do @(set sName=%~nxi & (if not exist "!sName:~0,4!" md "!sName:~0,4!") & move "%i" "!sName:~0,4!\") »

Путь само собой поменял, символов не 4, а 7(4 приводил для примера).
Только что попробовал провести аналогичное действие, но вместо "4" в код поставил "7" - всё повторилось.

Iska	01-11-2011 03:42 1786208

cifrovichek, в папке «E:\Песочница\0088» я создал файлы:

Код:

000ffaa-1.jpg

000ffaa-2.jpg

000ffaa-3.jpg

000ggaa-1.jpg

000ggaa-2.jpg

000ggaa-3.jpg

В командной строке, сделав текущим каталогом «E:\Песочница\0089», выполнил команду:

Код:

for %i in ("E:\Песочница\0088\*.jpg") do @(set sName=%~nxi & (if not exist "!sName:~0,7!" md "!sName:~0,7!") & move "%i" "!sName:~0,7!\")

Получил результат:

Код:

╔═════════════════════ E:\Песочница\0089 ╤══════╤════════╤═════╗

║и                 Имя                   │Размер│  Дата  │Время║

║⌂..                                     │ Вверх│01.11.11│02:35║

║├000ffaa                                │ Папка│01.11.11│02:35║

║├000ggaa                                │ Папка│01.11.11│02:35║

║                                        │      │        │     ║

…

Код:

╔═════════════════ E:\Песочница\0089\000ffaa ═══╤════════╤═════╗

║и                 Имя                   │Размер│  Дата  │Время║

║⌂..                                     │ Вверх│01.11.11│02:35║

║ 000ffaa-1                           jpg│     0│01.11.11│02:29║

║ 000ffaa-2                           jpg│     0│01.11.11│02:29║

║ 000ffaa-3                           jpg│     0│01.11.11│02:29║

║                                        │      │        │     ║

…

Код:

╔═════════════════ E:\Песочница\0089\000ggaa ═══╤════════╤═════╗

║и                 Имя                   │Размер│  Дата  │Время║

║⌂..                                     │ Вверх│01.11.11│02:35║

║ 000ggaa-1                           jpg│     0│01.11.11│02:29║

║ 000ggaa-2                           jpg│     0│01.11.11│02:29║

║ 000ggaa-3                           jpg│     0│01.11.11│02:29║

║                                        │      │        │     ║

…

А как делали Вы?

cifrovichek

01-11-2011 16:04 1786565

Iska, и я делаю так же. Посмотрите пожалуйста скрины, может я чего-то не замечаю?

Iska	01-11-2011 22:04 1786800

cifrovichek, научитесь, пожалуйста, снимать копию текста с содержимого окна консоли. Желания вручную набирать текст по скриншоту мало. Я понимаю, что есть моменты, когда важен именно скриншот, но в данном случае это не так.

Я проверил — у меня на Ваших файлах и путях работает, как и заявлено.

Есть предположение, что у нас с Вами разница в значении «enabledelayedexpansion» командного процессора. Я уже много лет меняю умолчальное значение…

Попробуйте запустить командный процессор с параметром «/V:ON»:

Код:

cmd.exe /v:on

а затем проделать те же манипуляции, что и ранее.

cifrovichek

02-11-2011 02:05 1786930

Iska, спасибо большое! Теперь всё получилось!

Iska	02-11-2011 03:47 1786951

Цитата:

Цитата cifrovichek

Теперь всё получилось! »

cifrovichek, это хорошо. Значит, мне только остаётся принести Вам свои извинения — я должен был бы помнить, что мои настройки командного процессора отличаются от принятых по умолчанию.

Boomer_777

03-06-2015 11:16 2514447

День добрый, у меня подобная проблемка, как описана выше:

Цитата:

Цитата cifrovichek

Есть папка с большим кол-вом файлов вида:
ffaa-1.jpg
ffaa-2.jpg
ffaa-3.jpg
ggaa-1.jpg
ggaa-2.jpg
ggaa-3.jpg
Нужно чтобы скрипт создал папку "ffaa" и запихнул в неё файлы ffaa-1.jpg, ffaa-2.jpg и ffaa-3.jpg.
Аналогично со следующей группой файлов. »

Только вот имена файлов до разделителя "-" имеют от 1 до 6 символов, но рассортировать также надо. Скрипт выложенный выше корректно отрабатывает только на фиксированном количестве символов. Как можно сделать такую сортировку средствами windows?

Iska	04-06-2015 06:21 2514756

Цитата:

Цитата Boomer_777

Только вот имена файлов до разделителя "-" имеют от 1 до 6 символов, »

Пробелов в числе этих символов нет? Попробуйте так:

Скрытый текст

Код:

@echo off

setlocal enableextensions enabledelayedexpansion



set sSourceFolder=%~1



if defined sSourceFolder (

        pushd "%sSourceFolder%" && (

                for %%i in ("*.jpg") do (

                        set sFullName=%%~nxi

                        for /f %%j in ("!sFullName:-= !") do set sPartName=%%j

                        

                        if not exist "!sPartName!" md "!sPartName!"

                        

                        >nul move "%%~i" "!sPartName!\" && echo Move file [%%~i] into folder [!sPartName!].

                )

                popd

        ) || (

                echo Can't find source folder [%sSourceFolder%].

                exit /b 2

        )

) else (

        echo Usage: %~nx0 ^<Source folder^>

        exit /b 1

)



endlocal

exit /b 0

Исходная папка задаётся параметром пакетного файла (также можно просто перетащить папку на пакетный файл в Проводнике).

Boomer_777

05-06-2015 00:59 2515114

Iska, спасибо, то, что доктор прописал прямо :)

belgarion

19-09-2015 17:05 2555195

Доброго времени суток!
У меня проблема именно такого же вида:

Цитата:

Цитата cifrovichek

отличие только в том, что до разделителя 3 символа ( например 020_1234) и в том, что мне обязательно нужно выполнить эту операцию (создать папки и переместить файлы) в vbs.

как "выдрать" три символа из имени файла я уже понял:

Функция разбора строки в именах файлов

set objFS = CreateObject("Scripting.FileSystemObject")
Set outputLines = CreateObject("System.Collections.ArrayList")
FldN = "наша папка содержащая файлы для разбора имен"
for each f in objFS.GetFolder(FldN).files
outputLines.Add f.Name
next
outputLines.Sort() ' 5 lines...

For Each outputLine in outputLines
set file = objFS.GetFolder(FldN).files.item (outputLine&"")
str = outputLine&""
intCharacters = 3
strNew = left(str, intCharacters)
next
Wscript.Quit

а дальше как ?

Iska	19-09-2015 20:07 2555260

Цитата:

Цитата belgarion

отличие только в том, что до разделителя 3 символа ( например 020_1234) »

Так на что мы ориентируемся — на количество символов или же на разделитель? Как поступаем в случае наличия в целевой папке одноимённого файла?

Вот примерная болванка кода (ориентируемся на разделитель «_», в случае наличия одноимённого файла будет возникать ошибка):

Скрытый текст

Код:

Option Explicit



Dim strSourceFolder



Dim objFile



Dim strDestFolder





If WScript.Arguments.Count = 1 Then

        With WScript.CreateObject("Scripting.FileSystemObject")

                strSourceFolder = .GetAbsolutePathName(WScript.Arguments.Item(0))

                

                If .FolderExists(strSourceFolder) Then

                        For Each objFile In .GetFolder(strSourceFolder).Files

                                strDestFolder = .BuildPath(strSourceFolder, Split(objFile.Name, "_")(0))

                                

                                If Not .FolderExists(strDestFolder) Then

                                        .CreateFolder strDestFolder

                                End If

                                

                                WScript.Echo objFile.Name, "--->", strDestFolder

                                

                                objFile.Move strDestFolder & "\"

                        Next

                Else

                        WScript.Echo "Can't find source folder [" & strSourceFolder & "]."

                        WScript.Quit 2

                End If

        End With

Else

        WScript.Echo "Usage: cscript.exe //nologo """ & WScript.ScriptName & """ <Source folder>"

        WScript.Quit 1

End If



WScript.Quit 0

belgarion

20-09-2015 11:56 2555403

Цитата:

Цитата Iska

Так на что мы ориентируемся »

Спасибо за помощь! Ваша "болванка" вполне годится. Только вопрос есть , как сделать чтоб папка в которой ищем файлы и создаем подпапки была уже задана в скрипте.

Iska	20-09-2015 14:40 2555476

belgarion, исходная папка задаётся аргументом скрипта. Также можно просто перетаскивать папку на скрипт в Проводнике.

Если совсем-совсем не хотите, то:

Скрытый текст

Код:

Option Explicit



Dim strSourceFolder



Dim objFile



Dim strDestFolder





With WScript.CreateObject("Scripting.FileSystemObject")

        strSourceFolder = .GetAbsolutePathName("C:\Мои проекты\16")

        

        If .FolderExists(strSourceFolder) Then

                For Each objFile In .GetFolder(strSourceFolder).Files

                        strDestFolder = .BuildPath(strSourceFolder, Split(objFile.Name, "_")(0))

                        

                        If Not .FolderExists(strDestFolder) Then

                                .CreateFolder strDestFolder

                        End If

                        

                        WScript.Echo objFile.Name, "--->", strDestFolder

                        

                        objFile.Move strDestFolder & "\"

                Next

        Else

                WScript.Echo "Can't find source folder [" & strSourceFolder & "]."

                WScript.Quit 2

        End If

End With



WScript.Quit 0

belgarion

20-09-2015 19:17 2555582

Цитата:

Цитата Iska

Если совсем-совсем не хотите, то: »

Спасибо выручили!

Nekis

23-01-2016 15:19 2598395

подскажите как изменить скрипт для сортировки фотографий по дате съемки из EXIF данных. когда скидываю с фотика в дате создания прописывается дата копирования, а не дата съёмки.

Iska	23-01-2016 16:34 2598418

Цитата:

Цитата Nekis

когда скидываю с фотика в дате создания прописывается дата копирования, а не дата съёмки. »

Естественно.

Цитата:

Цитата Nekis

как изменить скрипт для сортировки фотографий по дате съемки из EXIF данных »

Никак. Если Вы хотите заменить дату создания на дату съёмки из EXIF — просто воспользуйтесь BulkFileChanger: Change date/time/attributes of multiple files.

Nekis

23-01-2016 20:56 2598494

Спасибо.
выкрутился так:
1. через хорошую программу, которую использую вместо стандартного вивера для просмотра файлов - XnView (инструменты->изменить дату/время), заменил дату создания и изменения на дату съёмки из метаданных EXIF
2. потом воспользовался вашим скриптом

Iska	24-01-2016 00:27 2598533

Цитата:

Цитата Nekis

1. через хорошую программу, которую использую вместо стандартного вивера для просмотра файлов - XnView (инструменты->изменить дату/время), заменил дату создания и изменения на дату съёмки из метаданных EXIF »

Кстати, да — есть там такое :).

NLOLegion

03-01-2020 07:24 2903314

Цитата:

исходная папка задаётся аргументом скрипта

- как это делается?

и второй вопрос: как в скрипт ниже прописать путь к конкретной папке над которой надо выполнить работу?

Код:

Dim FSO, FldN, Fls, Fl, D, DtN, FlN

Set FSO = WScript.CreateObject("Scripting.FileSystemObject")



If WScript.Arguments.Count = 0 Then

  MsgBox "Не задано имя папки для распределения файлов по датам. ", vbExclamation, "Ошибка"

  WScript.Quit

End If



FldN = WScript.Arguments(0)

If Not FSO.FolderExists(FldN) Then

  MsgBox "Папка """ & FldN & """ не существует. ", vbExclamation, "Ошибка"

  WScript.Quit

End If



Set Fls = FSO.GetFolder(FldN).Files

For Each Fl In Fls

  D = GetDateName(Fl.DateLastModified)

  DtN = FSO.BuildPath(FldN, D)

  If Not FSO.FolderExists(DtN) Then FSO.CreateFolder DtN



  FlN = FSO.BuildPath(DtN, Fl.Name)

  If FSO.FileExists(FlN) Then

    If MsgBox("Файл """ & Fl.Name & """ уже существует в папке """ & D & """. " & vbCr & "Перезаписать?", vbQuestion + vbOKCancel, "Внимание") = vbOK Then

      FSO.DeleteFile FlN, True

      Fl.Move FlN

    End If

  Else

    Fl.Move FlN

  End If

Next



MsgBox "Скрипт завершен. ", vbInformation, "Финиш"

WScript.Quit



Private Function GetDateName(Dt)

  Dim M, D



  M = Month(Dt)

  D = Day(Dt)

  If M < 10 Then M = "0" & M

  If D < 10 Then D = "0" & D



  GetDateName = Year(Dt) & "-" & M & "-" & D

End Function

Iska	03-01-2020 10:27 2903328

Цитата:

Цитата NLOLegion

- как это делается? »

Всё описано в двадцать шестом сообщении.

NLOLegion

03-01-2020 15:35 2903375

Цитата:

Цитата Iska

Всё описано в »

, я конечно извиняюсь, но там другой скрипт. И для меня это как два языка, русский и японский.

Iska	03-01-2020 16:01 2903380

NLOLegion, принцип тот же — просто перетаскивайте папку на скрипт/ярлык на скрипт в Проводнике. Это Вас устроит?

NLOLegion

03-01-2020 16:06 2903383

Iska, да так всё работает! Отлично работает! Но в скрипте хочется сделать, а не получается. Пытался ваш файл с доработкой и без путей сравнить и от туда взять, но нифига не вышло.

Iska	03-01-2020 16:54 2903393

Удалите:

Код:

If WScript.Arguments.Count = 0 Then

  MsgBox "Не задано имя папки для распределения файлов по датам. ", vbExclamation, "Ошибка"

  WScript.Quit

End If

Замените:

Код:

FldN = WScript.Arguments(0)

на:

Код:

FldN = "путь к конкретной папке над которой надо выполнить работу"

Время: 11:48.