[решено] Копирование файлов из подкаталогов только за текущую дату.

[Чтец123]

Добрый день Уважаемые пользователи форума.
Передо мной стоит задача провести копирование файлов только за текущую дату.
В DirPath указана корневая директория, в которой создаются подкаталоги с именами папок (по дням юлианского календаря, к примеру 17036), в этих папках лежат некоторое количество файлов, нужно скопировать только файл с конкретным расширением, именно за сегодняшний день, в конкретную папку, без копирования директории (только файл).
У меня есть скрипт, но я никак не могу добавить туда фильтр по времени, не могли бы Вы помочь
Текст скрипта:

strComputer = "."

Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Const ForAppending = 8
Dim fso,NewFile,sFolder, Time, currentDate, DT, DateVal

Set objNetwork = CreateObject("WScript.Network")
Set fso = CreateObject("Scripting.FileSystemObject")

DirPath = "C:\Склады\"
TargetPath = "C:\1\Inward\22\"
Mask = ".x"

Function Format(N)
If N >= 10 Then
Format= Format & N
Else
Format= Format & "0" & N
End If
End Function
Set objFolder = fso.GetFolder(DirPath)

Set colSubfolders = objFolder.SubFolders
For Each objSubfolder in colSubfolders


varSrc = Replace(objSubfolder.Path, "\", "\\")
Set FileList = objWMIService.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name=""" & varSrc & """} Where " _
& "ResultClass = CIM_DataFile")
For Each objFile In FileList
On Error Resume Next

SFile = objFile.Drive & objFile.Path & _
objFile.FileName & "." & objFile.Extension

ext = Right(objFile.Extension, Len(objFile.Extension))
bufExt = objFile.Extension
Trgt_ext = TargetPattern & ext
strNewName = objFile.Drive & objFile.Path & _
objFile.FileName & "." & Trgt_ext


hh = Hour(Now)
mm = Minute(Now)
ss = Second(Now)
LogTime = format(hh)&":"&Format(mm)&":"&format(ss)


fso.CopyFile strNewName , TargetPath

Next
Next

[megaloman]

Чтец123, Если VBS не принципиально (не вчитывался в приведенный Вами скрипт), то вот CMD: @Echo Off

Set "From=Z:\Box_In\*.js"
Set "To=Z:\Box_Out"

Set "Now=%Date%"

FOR /F "usebackq delims=" %%f IN (`Dir /B /S /A:-D /T:C "%From%" 2^>nul`) DO (
FOR /F "usebackq tokens=1 delims= " %%d IN ('%%~tf') DO If "%Now%"=="%%d" Copy "%%f" "%To%\" >nul
)
@Echo Off

Set "From=Z:\Box_In"
Set "To=Z:\Box_Out"
Set "Mask=*.js"

Set "Comm=cmd /C >nul copy "@path" "%To%\""

FORFILES /P "%From%" /M "%Mask%" /S /D +0 /C "%Comm%"Или, если угодно, @Echo Off
FORFILES /P "Z:\Box_In" /M "*.js" /S /D +0 /C "cmd /C >nul copy "@path" "Z:\Box_Out\""
Тут, в принципе, и батника не надо, команду можно ручками набрать

[Iska]

(по дням юлианского календаря, к примеру 17036) »
Что такое 17036, что означает?

корневая директория, в которой создаются подкаталоги с именами папок …, в этих папках лежат некоторое количество файлов »
То есть, одноуровневая структура каталогов, но не двух- и более, так?

нужно скопировать только файл с конкретным расширением, именно за сегодняшний день, в конкретную папку, без копирования директории (только файл). »
Если таких файлов окажется несколько? Если файлы окажутся с одинаковыми именами? Если в «конкретной папке» уже существует файл с таким же именем?

[Чтец123]

Что такое 17036, что означает? »
Дата в формате yyddd.

То есть, одноуровневая структура каталогов, но не двух- и более, так? »
Трёхуровневая. Например я указываю C:\1\Inward как корневой каталог, в Inward-е в свою очередь подкаталоги, в которых подкаталоги (с именами приведёнными выше) в которых лежат файлы.

Если таких файлов окажется несколько? Если файлы окажутся с одинаковыми именами? Если в «конкретной папке» уже существует файл с таким же именем? »

Файлов и будет не один или два, но файлы будут с разными именами (это остаётся под ответственностью пользователей). А вот если конкретный файл уже существует то этот скрипт с ним ничего не делает, я проверял.

[Iska]

Дата в формате yyddd. »
Расшифруйте, как перевести 036 в обыденный, человеческий вид.

Трёхуровневая. Например я указываю C:\1\Inward как корневой каталог, в Inward-е в свою очередь подкаталоги, в которых подкаталоги (с именами приведёнными выше) в которых лежат файлы. »
Покажите вывод tree из «корневого» каталога.

Файлов и будет не один или два, но файлы будут с разными именами (это остаётся под ответственностью пользователей). »
А если окажутся с одинаковыми? Ответственность пользователей — это, конечно, хорошо, но скрипт об этом ничего не знает, и должен знать, что делать в такой ситуации.

А вот если конкретный файл уже существует то этот скрипт с ним ничего не делает, я проверял. »
Я Вам верю. Но меня не Ваш скрипт интересует, а алгоритм поведения. Итак, если в конечном каталоге одноимённый файл уже существует — то его не надо перезаписывать поверх, так?

[Чтец123]

Расшифруйте, как перевести 036 в обыденный, человеческий вид. »
036 - это второе февраля, 36 порядковый день в году.

Покажите вывод tree из «корневого» каталога. »
Я могу ошибаться, но вот он

Set objFolder = fso.GetFolder(DirPath)

Set colSubfolders = objFolder.SubFolders
For Each objSubfolder in colSubfolders

varSrc = Replace(objSubfolder.Path, "\", "\\")
Set FileList = objWMIService.ExecQuery _
("ASSOCIATORS OF {Win32_Directory.Name=""" & varSrc & """} Where " _
& "ResultClass = CIM_DataFile")
Но я не уверен, потому что начал работать с VBS совсем недавно.

А если окажутся с одинаковыми? Ответственность пользователей — это, конечно, хорошо, но скрипт об этом ничего не знает, и должен знать, что делать в такой ситуации. »
В этом случае я не задумывался. По идее он просто копирует один из них.

Я Вам верю. Но меня не Ваш скрипт интересует, а алгоритм поведения. Итак, если в конечном каталоге одноимённый файл уже существует — то его не надо перезаписывать поверх, так? »
Да, всё верно, перезаписывать сверху скрипт не должен.

[Iska]

036 - это второе февраля, 36 порядковый день в году. »
Ясно.

Я могу ошибаться, »
Ошиблись ;). Я имел в виду вывод команды tree, дабы я наглядно мог представить структуру каталогов. Ибо я реально не вижу в Вашем ТЗ трёх уровней, только два.

В этом случае я не задумывался. По идее он просто копирует один из них. »
Надо бы подумать. Копировать будет все подряд. Но, учитывая, что перезаписи быть не должно, будет скопирован только первый найденный, прочие будут пропущены. Так устроит?

И давайте уточним:
за сегодняшний день »
— созданные сегодня или модифицированные сегодня?

[Чтец123]

Ошиблись . Я имел в виду вывод команды tree, дабы я наглядно мог представить структуру каталогов. Ибо я реально не вижу в Вашем ТЗ трёх уровней, только два. »
Эту папку я указываю в качестве DirPath, Z:\111\222\333\444, файлы будут лежать здесь Z:\111\222\333\444\550\1\17033 и здесь Z:\111\222\333\444\551\1\17033, ну и так далее, где то четыре поддиректории, с разными днями.

Надо бы подумать. Копировать будет все подряд. Но, учитывая, что перезаписи быть не должно, будет скопирован только первый найденный, прочие будут пропущены. Так устроит? »
Да, буду Вам благодарен.

созданные сегодня или модифицированные сегодня? »
Важна именно дата создания, дата модифицирования не принимается во внимание.

[Чтец123]

@Echo Off
Set "From=Z:\Box_In"
Set "To=Z:\Box_Out"
Set "Mask=*.js"
Set "Comm=cmd /C >nul copy "@path" "%To%\""
FORFILES /P "%From%" /M "%Mask%" /S /D +0 /C "%Comm%" »

Локально всё работает нормально, Спасибо Вам.
Но вот при попытке запустить на сетевом диске выходить проблема. Выходит ошибка переменная среды не определена, хотя сетевой диск подключен.
Подскажите пожалуйста необходимо что то добавить подключение сетевого диска?

[Iska]

Чтец123, ну, вот как-то так:
Option Explicit

Dim strSourceFolder
Dim strDestFolder
Dim strFileExt

Dim objFSO


strSourceFolder = "C:\Склады"
strDestFolder = "C:\1\Inward\22"
strFileExt = "x"

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

If objFSO.FolderExists(strSourceFolder) Then
If objFSO.FolderExists(strDestFolder) Then
ScanSubFolders objFSO.GetFolder(strSourceFolder), strFileExt
Else
WScript.Echo "Can't find destination folder [" & strDestFolder & "]."
WScript.Quit 2
End If
Else
WScript.Echo "Can't find source folder [" & strSourceFolder & "]."
WScript.Quit 1
End If

Set objFSO = Nothing

WScript.Quit 0
'=============================================================================

'=============================================================================
Sub ScanSubFolders(objFolder, strFileExt)
Dim objFile
Dim objSubFolder

WScript.StdOut.WriteLine "[" & objFolder.Path & "]"

For Each objFile In objFolder.Files
If StrComp(objFSO.GetExtensionName(objFile.Name), strFileExt, vbTextCompare) = 0 Then
If DateDiff("d", objFile.DateCreated, Now()) = 0 Then
WScript.StdOut.Write vbTab & objFile.Name

If Not objFSO.FileExists(objFSO.BuildPath(strDestFolder, objFile.Name)) Then
objFile.Copy strDestFolder & "\", False
WScript.StdOut.WriteLine " : copied into destination folder [" & strDestFolder & "]."
Else
WScript.StdOut.WriteLine " : already exists in destination folder [" & strDestFolder & "]."
End If
End If
End If
Next

For Each objSubFolder In objFolder.SubFolders
ScanSubFolders objSubFolder, strFileExt
Next
End Sub
'=============================================================================

[Чтец123]

WScript.StdOut.WriteLine "[" & objFolder.Path & "]" »
Добрый день. Спасибо Вам за скрипт.
Я попытался его запустить, но он не отработал, ругается на комментируемую строку.
в начале строки должен быть Set objSubFolder = ?

[Iska]

Как именно «ругается»? Покажите скриншот.

Вы запускаете его из-под cscript.exe?

[Чтец123]

Как именно «ругается»? Покажите скриншот. »
Скриншот во вложении.

Вы запускаете его из-под cscript.exe? »
Видимо тут моя очередная ошибка. я просто сделал файл в формате VBS и запускаю его.

[Iska]

Видимо тут моя очередная ошибка. я просто сделал файл в формате VBS и запускаю его. »
Не ошибка. Просто WScript.StdOut работает только под консольным cscript.exe. То есть, запускайте в консоли в виде:
cscript.exe //nologo "Путь\Скрипт.vbs"
Потом сможете убрать/поменять/перенаправить вывод в файл/лог.