shveicar
|
 Posted: Fri Jun 08, 2012 23:58 Post subject: |
 |
|
Здравствуйте, наконец проблема решена (Спасибо Andrey_A)
Работает как часы.
| Code: | ' CreateStructureFileList.vbs
'======================== Описание ============================
' Создание пустой структуры из файл списка
'======================= Параметры ============================
' 1-й параметр: список файлов\папок
' 2-й параметр: куда\сохранять\пустую\структуру
'======================== Примеры ============================
' %P%N %t - создание структуры из списка под курсором
' "Путь\к\списку.txt" %p
' %L %t - создание структуры выделенного
' Автор: Аверин Андрей
' Версия: 1.1 (08.06.2012)
' Mail: Averin-And@yandex.ru
' Site: http://tc-image.3dn.ru/forum/3-496-2034-16-1339174881
'===============================================================
Set FSO = CreateObject("Scripting.FileSystemObject")
With WScript
Cnt = .Arguments.Count
If Cnt > 0 Then
Set tFile = FSO.OpenTextFile(WScript.Arguments(0), 1)
If Cnt > 1 Then
tPath = .Arguments(1) : If Not FSO.FolderExists(tPath) Then .Quit
If Right(tPath,1) = "\" Then : tPath = Left(tPath, Len(tPath) - 1)
End If
End If
End With
Do While Not tFile.AtEndOfStream
Line = tFile.ReadLine : n = InStr(Line, ":\")
If n > 0 Then Line = Mid(Line, 4)
NewPath = tPath & "\" & Line
CreateFolderInPath(NewPath)
If Not FSO.FolderExists(NewPath) Then FSO.CreateTextFile(NewPath)
Loop
CreateObject("WScript.Shell").Popup "Структура успешно создана!", 1, "Структура", 64
Set FSO = Nothing : Set tFile = Nothing : WScript.Quit
Sub CreateFolderInPath(FF)
With CreateObject("Scripting.FileSystemObject")
If InStr(FF, "%") > 0 Then FF = GetPath(FF)
If Len(.GetExtensionName(FF)) > 0 Then FF = .GetParentFolderName(FF)
If Not .FolderExists(FF) Then
Drive = .GetDriveName(FF)
If .DriveExists(Drive) Then
F = Split(FF, "\") : FL = Drive
For cr = 1 To Ubound(F)
FL = FL & "\" & F(cr) : If Not .FolderExists(FL) Then Call .CreateFolder(FL)
Next
End If
End If
End With
End Sub |
Возможно кому-то пригодиться
Спасибо. |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
