Перемещение файлов в папки по первым буквам их имён

[pavmazay]

Flasher

Добрый день! Есть ли возможность изменить скрипт, чтобы вместо файлов перемещались символьные NTFS-ссылки на папки?

[Avada]

pavmazay
Это, насколько понимаю, другая задача, не вполне сводимая к лёгкой модификации исходного скрипта (хотя, возможно, я неправ). Но в любом случае автор скрипта, к сожалению, на этом форуме больше не присутствует. Возможно, вам поможет здесь кто-то ещё. Особенно если вы задачу сформулируете как следует: симлинки могут (по крайней мере, стандартными средствами TC) перемещаться и как обычные каталоги, и просто как ссылки — либо вообще исключаться из операции (см. источники информации здесь). Вам что надо?

[pavmazay]

Avada

Мне нужен скрипт, подобный вышеизложенному. Этот скрипт прекрасно перемещает файлы по папкам по указанному количеству начальных символов, совпадающих у перемещаемого файла и папки, в которую нужно переместить. Мне нужен скрипт, который делал бы ровно тоже самое, только вместо перемещения выбранных файлов перемещал бы выбранные папки также по совпадению заданного количества начальных символов (или ссылки, потому что как заставить ТС видеть ссылку как файл простым действием я не нашел, ключи IgnoreLinks и CopyLinks, судя по описанию, ссылку файлом не делают, проба изменения ключа CopyLinks тоже результата не дала). С точки зрения непрограммиста требуется изменить строку 59 с FSO.MoveFile на FSO.MoveFolder, но этого явно недостаточно, строки выше тоже надо изменить, но я не знаю как, метод тыка ничего не дал.

[Avada]

pavmazay
Таким образом, вам нужно, чтобы, помимо всего прочего, ссылки обрабатывались как каталоги, перемещаясь со всем содержимым оригинальных каталогов. Как выше уже сказано, ждите ответа.

[pavmazay]

Версия для папок и символьных ссылок, может кому-то пригодится

Код: Выделить всё

'•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Перемещение выделенных папок и символьных ссылок в папки с тем же началом
' в имени, если под этот критерий подходит только одна папка в получателе

' Параметры:
'  1) %WL
'  2) "<путь назначения>"
'  3) <число первых совпавших символов> (при отсутствии вводим в окне)
'  4) <максимальное число символов> (0 - отключить; при отсутствии - в окне)

' Примеры:
'  1) %WL C:\Тест
'  2) %WL "%T" 3 0
'  3) %WL "%T" "" 6
'  4) %WL "%T" 5 20
'  							
' Автор - Flasher © (с дополнением pavmazay)
'•••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
With WScript.Arguments
  C = .Count : If C = 0 Then WScript.Quit
  On Error Resume Next
  List = .Item(0) : Path = .Item(1)
  If C < 3 Then
    Num = "" : Chek Num, ""
  Else
    Num = .Item(2) : If Len(.Item(2)) = 0 Then Chek Num, ""
  End If
  If C < 4 Then
    Max = "" : Chek Max, "МАКСИМАЛЬНОЕ "
  Else
    Max = .Item(3) : If Max = 0 Then Max = Num
  End If
  On Error Goto 0
  If C < 2 Then : MsgBox "Укажите не менее 2-ух параметров!", 4144, _
  "Рассортировка файлов по папкам" : WScript.Quit : End if
End With : If Right(Path, 1) <> "\" Then Path = Path & "\"

Sub Chek(Count, Word)
  L = vbNewline
  Do Until IsNumeric(Count)
    Count = InputBox(L&L&L&L&L& "Введите " & Word & "число первых" & _
    " символов в именах:", "Рассортировка файлов по папкам", 3)
    If Trim(Count) = "" Then WScript.Quit
  Loop
End Sub

Set FSO = CreateObject("Scripting.FileSystemObject")
Set SbF = FSO.GetFolder(Path).SubFolders
Set NSp = CreateObject("Shell.Application").NameSpace(Path)

For Each F in Split(FSO.GetFile(List).OpenAsTextStream(1, -1).ReadAll, vbNewline)
  If F > vbNullString Then
    If FSO.FolderExists(F) Then
      For i = Num to Max
        Start = Left(FSO.GetBaseName(F), i) : Set Items = NSP.Items
		Items.Filter 32+64, Start & "*"
        If Items.Count = 1 Then
          For Each FF in SbF
            If StrComp(Start, Left(FSO.GetFileName(FF), i), 1) = 0 Then
				Fnew = Left(F, Len(F)-1)
			    FSO.MoveFolder Fnew, FF & "\" : Exit For
			End If
          Next
        End If : Set Items = Nothing
      Next
    End If
  End If
Next : Set FSO = Nothing : Set NSP = Nothing : Set SbF = Nothing : WScript.Quit