| View previous topic :: View next topic |
| Author |
Message |
natalja
Joined: 19 Jun 2009
Posts: 10
|
 (Separately) Posted: Fri Jun 19, 2009 13:54 Post subject: перемещение файлов и папок в соответствии с категорией |
 |
|
Имеется таблица Excel с данными след. вида:
Имя1 Имя2 Категория Путь (имя2, путь получены из ТС).
Подскажите пожалуйста, возможно ли в ТС
1)разместить все файлы и папки в соответствии с категорией по папкам с названиями этих категорий
2)заменить все имена (т.е. Имя2 на Имя1)
| ! | Avada: | | Перенесено из "Секретов и советов" в "Автоматизацию". | |
|
| Back to top |
|
 |
Вахмурка
Joined: 27 Dec 2004
Posts: 2584
Location: Большая деревня Москва
|
| (Separately) Posted: Fri Jun 19, 2009 14:12 Post subject: |
|
|
2) можно. Надо оставить только колонку имя2 (т.е. новое имя) и сохранить в текстовом виде, а потом поместить в буфер (впрочем, не исключено, что можно положить в буфер и напрямую из экселя - надо попробовать). Далее открываем MultiRenameTool и видим кнопочку с иконкой папки (там всего одна кнопка с иконкой). Жмем кнопку и потом Edit names... Открывается окно редактора, куда можно вставить колонку имен из буфера. Все.
1) - не знаю. Помнится, какие-то приемы переименования по списку обсуждались... Попробуй поискать по словам "переименование по списку".
Проблема, как я понимаю, не только в размещении, а в создании кучи директорий с именами из списка.
[Добавлено]
1. Посмотри эту ветку.
2. Подумал, что, все гениальное должно быть просто. Решение первой проблемы - БАТНИК! Осталось сбросить текст в файл, немного позаменять глобально, и вуаля - запускай на выполнение и получай результат.
_________________
Сайт PowerPro+Total Commander
Скрипты PowerPro для Total Commander
* * *
«Не усматривайте злого умысла в том, что вполне объяснимо глупостью» (Р. Хэнлон) |
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия
|
| (Separately) Posted: Sun Jun 21, 2009 16:00 Post subject: |
|
|
natalja
Можно и 1, и 2.
Я правильно понимаю, есть файл "Путь\Имя2", и его надо переместить как "Путь\Категория\Имя1"?
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
| Back to top |
|
|
natalja
Joined: 19 Jun 2009
Posts: 10
|
| (Separately) Posted: Mon Jun 22, 2009 12:25 Post subject: |
|
|
| да, именно так |
|
| Back to top |
|
|
natalja
Joined: 19 Jun 2009
Posts: 10
|
| (Separately) Posted: Tue Jun 23, 2009 13:26 Post subject: |
|
|
| только как это сделать? |
|
| Back to top |
|
|
Вахмурка
Joined: 27 Dec 2004
Posts: 2584
Location: Большая деревня Москва
|
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия
|
| (Separately) Posted: Tue Jun 23, 2009 16:20 Post subject: |
|
|
natalja
vbs-скрипт:
| Code: | '====================================================================================
' Переименование и перемещение файлов или папок согласно Excel-файла.
' Столбцы в таблице - Имя1, Имя2, Категория, Путь, Статус.
' Параметры скрипта:
' {excel-файл}
'====================================================================================
Option Explicit
'=============== Изменяемые параметры ===============================================
Const StartCell = "A2" 'Первая ячейка таблицы
'====================================================================================
Dim FSO, WSH, Mess, XlsFile, FF, Path, FPath, FNewPath, Status, objXL, i, j
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WSH = CreateObject("WScript.Shell")
Set objXL = CreateObject("Excel.Application")
Set FF = CreateObject("Scripting.Dictionary")
MessDefine
CheckParams
objXL.Workbooks.Open XlsFile
i = objXL.Range(StartCell).Row
j = objXL.Range(StartCell).Column
Do
Path = GetPath(Trim(objXL.Cells(i,j+3).Value)) & "\"
FPath = Path & Trim(objXL.Cells(i,j+1).Value)
Path = Path & Trim(objXL.Cells(i,j+2).Value) & "\"
FNewPath = Path & Trim(objXL.Cells(i,j ).Value)
If Not FF.Exists(FPath) Then
If FExists(FPath) Then
If Not FExists(FNewPath) Then
BuildTree(Path)
On Error Resume Next
FMove FPath, FNewPath
If Err.Number = 0 Then
Status = Mess(6)
Else
Status = Err.Description
End If
On Error GoTo 0
Else
Status = Mess(5)
End If
Else
Status = Mess(4)
End If
Else
Status = Mess(3)
End If
FF.Add FPath, Status
objXL.Cells(i,j+4).Value = Status
i = i + 1
Loop Until objXL.Cells(i,j).Value = ""
'Сохранение результатов
objXL.Application.ActiveWorkbook.Save
objXL.Quit()
MsgBox Mess(7), vbInformation + vbOKOnly, Mess(0)
Quit
'===== Процедуры и функции ===============================================================
'Проверка входных параметров
Sub CheckParams
With WScript
If .Arguments.Count = 0 Then
MsgBox Mess(1), vbCritical + vbOKOnly, Mess(0)
Quit
End If
XlsFile = GetPath(.Arguments(0))
If Not FSO.FileExists(XlsFile) Then
MsgBox Mess(2), vbCritical + vbOKOnly, Mess(0)
Quit
End If
End With
End Sub
'Путь
Function GetPath(pPath)
GetPath = FSO.GetAbsolutePathName(WSH.ExpandEnvironmentStrings(pPath))
End Function
'Существование файла или папки
Function FExists(pPath)
FExists = FSO.FileExists(pPath) Or FSO.FolderExists(pPath)
End Function
'Перемещение файла или папки
Function FMove(pPath, pNewPath)
If FSO.FileExists(pPath) Then FSO.MoveFile pPath, pNewPath
If FSO.FolderExists(pPath) Then FSO.MoveFolder pPath, pNewPath
End Function
'Создание дерева папок
Sub BuildTree(pFolder)
Dim lPF
lPF = FSO.GetParentFolderName(pFolder)
If Not FSO.FolderExists(lPF) Then
BuildTree(lPF)
Else
If Not FSO.FolderExists(pFolder) Then FSO.CreateFolder pFolder
End If
End Sub
'Описание сообщений
Sub MessDefine
Set Mess = CreateObject("Scripting.Dictionary")
With Mess
.Add 0, "Переименование и перемещение согласно Excel-файла"
.Add 1, "Не указаны параметры!"
.Add 2, "Excel-файл не существует!"
.Add 3, "Повторное вхождение в список"
.Add 4, "Исходный файл или папка не существует"
.Add 5, "Уже существует целевой файл или папка с требуемым именем"
.Add 6, "Успешное выполнение"
.Add 7, "Операция завершена."
End With
End Sub
'Выход
Sub Quit
Set objXL = Nothing
Set FF = Nothing
Set Mess = Nothing
Set WSH = Nothing
Set FSO = Nothing
WScript.Quit
End Sub |
Сохрани код в текстовый файл с расширением vbs. Перетащи получившийся файл на панель TC - получится кнопка.
Затем 2 варианта:
1. Либо на кнопке нажми правую кнопку мыши -> Изменить. В строке "Параметры" напиши полный путь к Excel-файлу -> ОК. Нажми кнопку.
2. Либо просто перетащи Excel-файл на эту кнопку.
В Excel-файле должно быть 4 заполненных колонки - Имя1, Имя2, Категория, Путь. После выполнения операции будет заполнена 5-я колонка Статус.
Внимание! В момент выполнения скрипта Excel-файл НЕ должен быть открыт.
_________________
Нет, я не сплю. Я просто медленно моргаю.
Last edited by Batya on Wed Jun 24, 2009 14:19; edited 1 time in total |
|
| Back to top |
|
|
natalja
Joined: 19 Jun 2009
Posts: 10
|
| (Separately) Posted: Wed Jun 24, 2009 10:48 Post subject: |
|
|
Спасибо большое за скрипт и указания!!!
Правда появилась еще пара воросов
1)ошибка 800A0005 стр 35, симв 9
2)можно ли его преобразовать так, чтобы перемещать не только файлы, но и папки? |
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия
|
| (Separately) Posted: Wed Jun 24, 2009 11:10 Post subject: |
|
|
| natalja wrote: | | 1)ошибка 800A0005 стр 35, симв 9 |
Когда появится сообщение об ошибке, нажми на клавиатуре Ctrl+C, а потом здесь вставь текст - Ctrl+V. Хочу увидеть полное сообщение.
| natalja wrote: | | 2)можно ли его преобразовать так, чтобы перемещать не только файлы, но и папки? |
Можно. Через некоторое время сделаю.
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
| Back to top |
|
|
natalja
Joined: 19 Jun 2009
Posts: 10
|
| (Separately) Posted: Wed Jun 24, 2009 11:19 Post subject: |
|
|
---------------------------
Windows Script Host
---------------------------
Сценарий: D:\Наталья\папка\Переименование.vbs
Строка: 35
Символ: 9
Ошибка: Недопустимый вызов или аргумент процедуры
Код: 800A0005
Источник: Ошибка выполнения Microsoft VBScript
---------------------------
ОК
--------------------------- |
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2218
Location: Москва, Россия
|
| (Separately) Posted: Wed Jun 24, 2009 12:33 Post subject: |
|
|
nataljaНапиши в скрипте перед этой строкой ("FSO.MoveFile FilePath, FilePathNew") вот это:
| Code: | MsgBox FilePath & " -> " & FilePathNew |
Это отладочное сообщение. Когда оно возникнет, скопируй его также через Ctrl+C и пришли.
_________________
Нет, я не сплю. Я просто медленно моргаю. |
|
| Back to top |
|
|
natalja
Joined: 19 Jun 2009
Posts: 10
|
| (Separately) Posted: Wed Jun 24, 2009 12:53 Post subject: |
|
|
---------------------------
---------------------------
D:\Наталья\работа с книгами\Воспитывать мальчишек... как.txt -> D:\Наталья\работа с книгами\для родителей\Воспитывать мальчишек... Как?
---------------------------
ОК
--------------------------- |
|
| Back to top |
|
|
natalja
Joined: 19 Jun 2009
Posts: 10
|
| (Separately) Posted: Wed Jun 24, 2009 12:56 Post subject: |
|
|
---------------------------
Windows Script Host
---------------------------
Сценарий: D:\Наталья\папка\Переименование.vbs
Строка: 36
Символ: 8
Ошибка: Недопустимый вызов или аргумент процедуры
Код: 800A0005
Источник: Ошибка выполнения Microsoft VBScript
---------------------------
ОК
--------------------------- |
|
| Back to top |
|
|
natalja
Joined: 19 Jun 2009
Posts: 10
|
| (Separately) Posted: Wed Jun 24, 2009 12:59 Post subject: |
|
|
| понала!!! здесь вопрос в имени!!! |
|
| Back to top |
|
|
natalja
Joined: 19 Jun 2009
Posts: 10
|
| (Separately) Posted: Wed Jun 24, 2009 13:02 Post subject: |
|
|
Все получилось!!! Прошу прощения за невнимательность  |
|
| Back to top |
|
|
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
