1 (изменено: DDK, 2012-08-06 22:42:53)

Тема: VBS: Скрипт поиска и копирования файлов по маске

Здравствуйте!

Помогите написать скрипт! Есть видеокамера, на её карте памяти в разных папках (по датам) лежат файлы с расширением *.mts. Программа копирования файлов с камеры просто идиотская - копирует всю файловую структуру с карты памяти камеры... и сиди потом выковыривай видео-файлы из кучи мусора.

Идея: написать скрипт, которому надо будет указать расширение файлов и путь до папки на карте памяти, в подпапках которой надо будет искать файлы с этим разрешением и копировать эти файлы в указанную папку, попутно проверяя, нет ли в папке назначения уже файла с таким же именем (может его уже ранее скопировали).

Нашёл тему, в которой обсуждается почти такая же задача, но там немного не то: http://forum.script-coding.com/viewtopic.php?id=4060

В перспективе потом ещё хочу модифицировать скрипт так, чтобы вместо копирования файла он производил конвертирование в другой формат с помощью вспомогательной программы-конвертера.

Поможите!

2

Re: VBS: Скрипт поиска и копирования файлов по маске

Вот самый подходящий скрипт, наверное, из той темы... осталось как-то добавить копирование файлов в папку назначение и попутную проверку на наличие файла с таким именем.

Dim fso,mySet,myDir,st
Dim s()
i=0

Dim regEx, Match, Matches, regtxt
Set regEx = New RegExp
regEx.IgnoreCase = True
regEx.Global = True

mySet="*.jpg *.gif"

For Each m1 in Split(mySet," ",-1,1)
    regtxt = regtxt & "\." & m1 & "$|"
Next
regEx.Pattern = Left(regtxt, Len(regtxt)-1)

myDir="c:\111"

Set fso = CreateObject("Scripting.FileSystemObject")

Sub ListFolder(curDir)
On Error Resume Next
    For Each f1 in fso.GetFolder(curDir).Files
    If Err.Number = 0 Then
            If regEx.Test(f1) Then
                ReDim Preserve s(i+1)
                s(i) = f1.path
                i=i+1
            End If
    End If
    Next
Err.Clear
    For Each s1 in fso.GetFolder(curDir).SubFolders
        If Err.Number = 0 Then
            ListFolder(s1.path)
        End If
    Next
Err.Clear
On Error Goto 0
End Sub

ListFolder(myDir)

For k=0 To i-1
        MsgBox "Количество файлов: " & i & vbCrLf & st
        st=k+1 & ") " & s(k) & vbCrLf
Next

3

Re: VBS: Скрипт поиска и копирования файлов по маске

Для решения описанной задачи возможно хватит командного файла (cmd или bat)
копируем файлы с видео: (из всех подкаталогов карты памяти с перезаписью уже скопиованных и созданием структуы папок)
   xcopy ?:\*.mts D:\kamera\*.* /S /E /C /Y
если хочешь очистить карту памяти от данных файлов
   del ?:\*.mts /S /Q

Следующим шагом, если есть утилита, конвертации запускаем её.

4

Re: VBS: Скрипт поиска и копирования файлов по маске

Fedor пишет:

Для решения описанной задачи возможно хватит командного файла (cmd или bat)
копируем файлы с видео: (из всех подкаталогов карты памяти с перезаписью уже скопиованных и созданием структуы папок)
   xcopy ?:\*.mts D:\kamera\*.* /S /E /C /Y

Спасибо! А можно как-то с помощью xcopy сделать так, чтобы все файлы тупо копировались в одну указанную папку? Тобишь, без сохранения оригинальной файловой структуры. Собственно, именно в этом и идея - одним кликом (скриптом) собрать со всех папок файлы и скопировать их в одну папку

5 (изменено: Fedor, 2012-08-10 21:28:28)

Re: VBS: Скрипт поиска и копирования файлов по маске

Можно (для командной строки!!!):
for /r ?:\ %i in (*.mts) do xcopy "%i" d:\kamera\*.* /Y
"%i" - именно так если есть файлы содержащие пробелы в имени, если уверен, что таких не будет, можно  просто %i.
Только есть риск потерять часть файлов с одинаковыми именами из разных каталогов.

Совсем убийственный вариант:
for /r ?:\ %i in (*.mts) do (xcopy "%i" d:\kamera\*.* /Y)&&(del %i /S /Q)
При удачном копировании файла с карты памяти удаляем его, при неудачном копировании файл не удалится, но перезапись файла то же считается удачным исходом копирования!!!
Выбирай что больше подходит.

P.S. если будешь писать cmd (bat) используй %%i

6

Re: VBS: Скрипт поиска и копирования файлов по маске

Fedor, спасибо огромное, ровно то что надо!!