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

[Iska]

Только вот имена файлов до разделителя "-" имеют от 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]

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

[belgarion]

Доброго времени суток!
У меня проблема именно такого же вида:
Есть папка с большим кол-вом файлов вида:
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.
Аналогично со следующей группой файлов. »

отличие только в том, что до разделителя 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]

отличие только в том, что до разделителя 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]

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

[Iska]

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]

Если совсем-совсем не хотите, то: »
Спасибо выручили!

[Nekis]

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

[Iska]

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

как изменить скрипт для сортировки фотографий по дате съемки из EXIF данных »
Никак. Если Вы хотите заменить дату создания на дату съёмки из EXIF — просто воспользуйтесь BulkFileChanger: Change date/time/attributes of multiple files (http://nirsoft.net/utils/bulk_file_changer.html).

[Nekis]

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

[Iska]

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

[NLOLegion]

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

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


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]

- как это делается? »
Всё описано в двадцать шестом сообщении (http://forum.oszone.net/post-2555476.html#post2555476).

[NLOLegion]

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

[Iska]

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

[NLOLegion]

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

[Iska]

Удалите:
If WScript.Arguments.Count = 0 Then
MsgBox "Не задано имя папки для распределения файлов по датам. ", vbExclamation, "Ошибка"
WScript.Quit
End If
Замените:
FldN = WScript.Arguments(0)
на:
FldN = "путь к конкретной папке над которой надо выполнить работу"