Total Commander Forum Index Total Commander
Форум поддержки пользователей Total Commander
Сайты: Все о Total Commander | Totalcmd.net | Ghisler.com | RU.TCKB
 
 RulesRules   SearchSearch   FAQFAQ   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Single Post  Topic: Автоматическое создание папок 
Author Message
Batya



PostPosted: Fri Feb 16, 2007 10:43    Post subject: Reply with quote

Нечто подобное я уже делал. Теперь немного проще:
Code:
'=====================================================================
' Создание папки по имени файла и перемещение в нее файла
' Может быть выделено несколько файлов

' Для создания папок в текущей панели
'   в параметрах вызова из TC должно быть прописано:
' %L

' Для создания папок в противоположной панели
'   в параметрах вызова из TC должно быть прописано:
' %L "%T"
'=====================================================================

If WScript.Arguments.Count = 0 Then
  MsgBox "Не указаны параметры!", vbOKOnly + vbError, "Внимание!"
  Wscript.Quit
End If

Dim TempFile, FSO, SelFile
Set FSO      = CreateObject("Scripting.FileSystemObject")
Set TempFile = FSO.OpenTextFile(WScript.Arguments(0), 1)

Dim FileName, FilePath, DashInName, NewFilePath
Do While Not TempFile.AtEndOfStream
  Set SelFile = FSO.GetFile(TempFile.ReadLine)
  FileName    = FSO.GetBaseName(SelFile)
  FilePath    = SelFile.ParentFolder
  If WScript.Arguments.Count > 1 Then
    NewFilePath = WScript.Arguments(1) & FileName
  Else
    NewFilePath = FilePath & "\" & FileName
  End If
  If Not FSO.FolderExists(NewFilePath) Then
    FSO.CreateFolder(NewFilePath)
  End If
  If Not FSO.FileExists(NewFilePath & "\" & FileName) Then
    FSO.MoveFile SelFile, NewFilePath & "\"
  Else
    MsgBox "Уже существует файл " & FileName & " в папке " & NewFilePath, vbOKOnly + vbExclamation, "Внимание!"
  End If
Loop
Set TempFile = Nothing
Set FSO      = Nothing
Set SelFile  = Nothing
Wscript.Quit
View user's profile Send private message


Powered by phpBB © 2001, 2005 phpBB Group