Перемещение файлов в одноименную папку Total Comander

NatalieRedFox_333

Чего мне бояться? - подумала Красная Шапочка...)))
Топикстартер
Сообщения
1 512
Реакции
115
Вот нашла, решила поделиться....)))
создай текстовый файл, вставь туда скрипт, сохрани файл как blabla.vbs, перетащи его на панель кнопок Total Comander ))) Done!!!

untitled-jpg.146803


Код:
'=====================================================================
' Создание папки по имени файла и перемещение в нее файла
' Может быть выделено несколько файлов

' Для создания папок в текущей панели
'   в параметрах вызова из 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
 

Вложения

  • Untitled.jpg
    Untitled.jpg
    13 КБ · Просм.: 166
Последнее редактирование:

Gad

Сообщения
2 781
Реакции
1 316
2021-10-06_17-31-23.png

Круто конечно, но зачем файл в одноименную папку запихивать? '))'
 
  • Спасибо
Реакции: NatalieRedFox_333

NatalieRedFox_333

Чего мне бояться? - подумала Красная Шапочка...)))
Топикстартер
Сообщения
1 512
Реакции
115

NatalieRedFox_333

Чего мне бояться? - подумала Красная Шапочка...)))
Топикстартер
Сообщения
1 512
Реакции
115
а еще мне надо скрипт который будет запихивать выделенные файлы(папки) в отдельную папку в другом окне....
Есть такой?
Т е в одном окне выделяются допустим 20 файлов и запихиваются все в одну папку, но в другом окне...
 

NatalieRedFox_333

Чего мне бояться? - подумала Красная Шапочка...)))
Топикстартер
Сообщения
1 512
Реакции
115

lev

Модератор
15 лет на форуме
Сообщения
2 056
Реакции
1 946
Вроде бы так:
Код:
'=====================================================================
' Создание папки по имени файла и перемещение в нее файла
' Может быть выделено несколько файлов

' Для создания папок в противоположной панели
'   в параметрах вызова из 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)

NewFilePath = WScript.Arguments(1) 
counter=1
NewDir=NewFilePath & "1"
Do While FSO.FolderExists(NewDir)
  counter = counter + 1
  NewDir = NewFilePath & "\" & counter & "\"
Loop

FSO.CreateFolder (NewDir)

Dim FileName, FilePath, DashInName, NewFilePath
Do While Not TempFile.AtEndOfStream
  Set SelFile = FSO.GetFile(TempFile.ReadLine)
  
  If Not FSO.FileExists(NewDir & "\" & FileName) Then
    FSO.MoveFile SelFile, NewDir & "\"
  Else
    MsgBox "Уже существует файл " & FileName & " в папке " & NewFilePath, vbOKOnly + vbExclamation, "Внимание!"
  End If
Loop
Set TempFile = Nothing
Set FSO      = Nothing
Set SelFile  = Nothing
WScript.Quit
 
  • Спасибо
Реакции: NatalieRedFox_333

NatalieRedFox_333

Чего мне бояться? - подумала Красная Шапочка...)))
Топикстартер
Сообщения
1 512
Реакции
115
Вроде бы так:
Код:
'=====================================================================
' Создание папки по имени файла и перемещение в нее файла
' Может быть выделено несколько файлов

' Для создания папок в противоположной панели
'   в параметрах вызова из 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)

NewFilePath = WScript.Arguments(1)
counter=1
NewDir=NewFilePath & "1"
Do While FSO.FolderExists(NewDir)
  counter = counter + 1
  NewDir = NewFilePath & "\" & counter & "\"
Loop

FSO.CreateFolder (NewDir)

Dim FileName, FilePath, DashInName, NewFilePath
Do While Not TempFile.AtEndOfStream
  Set SelFile = FSO.GetFile(TempFile.ReadLine)
 
  If Not FSO.FileExists(NewDir & "\" & FileName) Then
    FSO.MoveFile SelFile, NewDir & "\"
  Else
    MsgBox "Уже существует файл " & FileName & " в папке " & NewFilePath, vbOKOnly + vbExclamation, "Внимание!"
  End If
Loop
Set TempFile = Nothing
Set FSO      = Nothing
Set SelFile  = Nothing
WScript.Quit
только ошибку выдает....
untitled-jpg.146809
 

Вложения

  • Untitled.jpg
    Untitled.jpg
    43.3 КБ · Просм.: 102

NatalieRedFox_333

Чего мне бояться? - подумала Красная Шапочка...)))
Топикстартер
Сообщения
1 512
Реакции
115
может с кавычками не порядок?
тут - "%L" "%T"

Код:
'=====================================================================
' Создание папки по имени файла и перемещение в нее файла
' Может быть выделено несколько файлов

' Для создания папок в противоположной панели
'   в параметрах вызова из 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)

NewFilePath = WScript.Arguments(1)
counter=1
NewDir=NewFilePath & "1"
Do While FSO.FolderExists(NewDir)
  counter = counter + 1
  NewDir = NewFilePath & "\" & counter & "\"
Loop

FSO.CreateFolder (NewDir)

Dim FileName, FilePath, DashInName, NewFilePath
Do While Not TempFile.AtEndOfStream
  Set SelFile = FSO.GetFile(TempFile.ReadLine)
 
  If Not FSO.FileExists(NewDir & "\" & FileName) Then
    FSO.MoveFile SelFile, NewDir & "\"
  Else
    MsgBox "Уже существует файл " & FileName & " в папке " & NewFilePath, vbOKOnly + vbExclamation, "Внимание!"
  End If
Loop
Set TempFile = Nothing
Set FSO      = Nothing
Set SelFile  = Nothing
WScript.Quit
 

lev

Модератор
15 лет на форуме
Сообщения
2 056
Реакции
1 946
По условиям задачи требовалось перемещать файлы, а не папки
 
  • Спасибо
Реакции: NatalieRedFox_333

NatalieRedFox_333

Чего мне бояться? - подумала Красная Шапочка...)))
Топикстартер
Сообщения
1 512
Реакции
115
Вроде бы так:
Код:
'=====================================================================
' Создание папки по имени файла и перемещение в нее файла
' Может быть выделено несколько файлов

' Для создания папок в противоположной панели
'   в параметрах вызова из 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)

NewFilePath = WScript.Arguments(1)
counter=1
NewDir=NewFilePath & "1"
Do While FSO.FolderExists(NewDir)
  counter = counter + 1
  NewDir = NewFilePath & "\" & counter & "\"
Loop

FSO.CreateFolder (NewDir)

Dim FileName, FilePath, DashInName, NewFilePath
Do While Not TempFile.AtEndOfStream
  Set SelFile = FSO.GetFile(TempFile.ReadLine)
 
  If Not FSO.FileExists(NewDir & "\" & FileName) Then
    FSO.MoveFile SelFile, NewDir & "\"
  Else
    MsgBox "Уже существует файл " & FileName & " в папке " & NewFilePath, vbOKOnly + vbExclamation, "Внимание!"
  End If
Loop
Set TempFile = Nothing
Set FSO      = Nothing
Set SelFile  = Nothing
WScript.Quit

lev кавычки должны быть и ошибка какая то...​

 

NatalieRedFox_333

Чего мне бояться? - подумала Красная Шапочка...)))
Топикстартер
Сообщения
1 512
Реакции
115
По условиям задачи требовалось перемещать файлы, а не папки
а еще мне надо скрипт который будет запихивать выделенные файлы(папки) в отдельную папку в другом окне....
я папками пробовала....
 
Последнее редактирование:

NatalieRedFox_333

Чего мне бояться? - подумала Красная Шапочка...)))
Топикстартер
Сообщения
1 512
Реакции
115
По условиям задачи требовалось перемещать файлы, а не папки
а для папок можно поправить? мне вообще папки надо выбрать и закинуть все выделенные в одну...