Zmy
|
 Posted: Mon Mar 20, 2017 10:54 Post subject: |
 |
|
Попробуйте так.
| Code: | ' Создание папки по имени файла и перемещение в нее файла
' Может быть выделено несколько файлов
' Для создания папок в текущей панели
' в параметрах вызова из TC должно быть прописано:
' %L
' Для создания папок в противоположной панели
' в параметрах вызова из TC должно быть прописано:
' %L "%T"
' основан на коде Batya
'=====================================================================
If WScript.Arguments.Count = 0 Then
MsgBox "Нужны такие параметры:" + vbNewLine + vbNewLine + "%L" + vbNewLine + vbNewLine + "Или такие параметры:" + vbNewLine + vbNewLine + "%L ""%T""", vbOKOnly + vbError, "No Parameteres"
Wscript.Quit
End If
Dim TempFile, FSO, SelFile
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TempFile = FSO.OpenTextFile(WScript.Arguments(0), 1)
Name = InputBox("Введите количество символов", "Input", 10)
If Name = "" Then
Wscript.Quit
End If
Dim FileName, FilePath, DashInName, NewFilePath
Do While Not TempFile.AtEndOfStream
Set SelFile = FSO.GetFile(TempFile.ReadLine)
FileName = FSO.GetBaseName(SelFile)
FilePath = SelFile.ParentFolder
LName = (Left(FileName, Name))
If WScript.Arguments.Count > 1 Then
NewFilePath = WScript.Arguments(1) & LName
Else
NewFilePath = FilePath & "\" & LName
End If
If Not FSO.FolderExists(NewFilePath) Then
FSO.CreateFolder(NewFilePath)
End If
If Not FSO.FileExists(NewFilePath & "\" & FileName & "." & FSO.GetExtensionName(SelFile)) Then
FSO.MoveFile SelFile, NewFilePath & "\"
Else
MsgBox "Files Already Exist", vbOKOnly + vbError, "Error"
End If
Loop
Set TempFile = Nothing : Set FSO = Nothing : Set SelFile = Nothing : Wscript.Quit
|
Last edited by Zmy on Sun Mar 26, 2017 08:15; edited 2 times in total |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
