2014-10-08 8 views
0

Я хочу создать папку в нескольких папках доступной (по VBScript)Я хочу создать папку в нескольких папках, доступных

Примера:

У меня есть несколько папок: ABC, XYZ, IJK ... и т.д.

  • Я хочу, чтобы создать папку, как «ABC» во всех папках азбука, хуг, тю, ijk..etc
  • Затем переместите все файлы «JPG» в каждой папке аЬс, хуг, тю, ijk .. в папку «ABC» только что созданной папки
  • Проверка каждой папки и посмотреть, если папка «ABC» или нет, пустой или не

strFolder = "/" '<== This place how to automatically create a folder "ABC" 
        ' in the directory available 

SET objFSO = CREATEOBJECT("Scripting.FileSystemObject") 

'Move file jpg '<== I do not get it 

IF objFSO.FolderExists(strFolder) = FALSE THEN 
    objFSO.CreateFolder strFolder 
    wscript.echo "Folder Created" 
ELSE 
    wscript.echo "Folder already exists" 
END IF 
+0

Ваш вопрос не является вопросом. :) Есть ли конкретная проблема, с которой вы сталкиваетесь? – Bond

+0

Спасибо, что напомнили мне! Я редактировал, ты можешь мне помочь? –

+0

Как вы определяете папки, в которых вы хотите создать новую подпапку? Где находятся все файлы jpg, прежде чем вы их перемещаете? –

ответ

0

Чтобы ответить на вопрос, который был написан в ответ ...

Dim fso, shl, curdir, folder, file, newfoldername, newfolderpath 
Set fso = CreateObject("Scripting.FileSystemObject") 
Set shl = CreateObject("WScript.Shell") 
curdir = shl.CurrentDirectory 
newfoldername = "big" 

For Each folder In fso.GetFolder(curdir).Subfolders 
    newfolderpath = fso.BuildPath(folder.Path, newfoldername) 
    If Not fso.FolderExists(newfolderpath) Then 
     fso.CreateFolder newfolderpath 
     WScript.Echo newfolderpath & " created" 
    Else 
     WScript.Echo newfolderpath & " already exists" 
    End If 
    For Each file In folder.Files 
     MoveFile file.Path, newfolderpath 
    Next 
Next 

Sub MoveFile(source, destination) 
    On Error Resume Next 
    fso.CopyFile source, destination & "\", True ' true = overwrite 
    If Err Then 
     WScript.Echo "Error copying " & source & " to " & destination & ": " & Err.Description 
     WScript.Quit 
    Else 
     fso.DeleteFile source, True 
    End If 
    On Error GoTo 0 
End Sub 

Подменю MoveFile действует как обычный ход, то есть копирует файл, а затем удаляет источник в случае успеха. Лучше, чем использовать встроенную функцию fso.MoveFile, поскольку она не обрабатывает перезапись существующих файлов.

Подводя итог ... на каждую подпапку в текущем каталоге, смотрите, существует ли подпапка \ big. Если это так, то эхо-текст, иначе создайте папку и текст эха. Затем для каждого файла в этой подпапке переместите его в папку подкаталога \ большую папку, перезапишив существующие файлы и удалив исходный файл, если копия прошла успешно. Вы можете добавить материал, чтобы проверить расширение перед тем, как переместить (чтобы ориентироваться только на определенные типы файлов), или выйти из подкаталога, если файл уже существует (чтобы не перезаписывать существующие файлы).

+0

Прежде всего, спасибо за ответ, отличный алгоритм! Мне очень жаль, я не знаю, как закончить этот топпик? –

Смежные вопросы