Консультации Портала - Консультация #175977

Задать вопрос Консультации Пользователи Форум

Задать вопрос экспертам

Консультация № 175977

10.01.2010, 17:02

35.00 руб.

0 40 1

Компьютеры Программирование

Переименование файлов из Eхсel без использования макросов!

Уважаю VB и VBA.
Но не владею ими.
И не успею освоить -старый...

Уважаемые эксперты, подскажите, пожалуйста - есть ли возможность переименовывать файлы в папке силами Excel , не прибегая к макросам?
Я не халявщик, я отсканировал более тысячи книг (не нарушая авторских прав) военно-технического содержания и выложил их в свободный доступ.
http://www.russianarms.ru/forum/index.php?board=656.0
Одна беда. Завален копиями вариантов этих материалов!

Итак.
Имею программку, которая формирует Excel-совместимый файл с таблицей содержащей пути и имена файлов наименований книг.
Содержимое столбца выглядит так:
C:\! Skan\! UzA\БМП-2. Боевая машина пехоты БМП-2. ТО и ИЭ. Часть 1. 1987(djvu)

строк в столбце может быть иногда чуть менее чем 65000

Имею желание скопировать этот столбец в соседний и отредактировать имя файла, а затем произвести какие-то действия, чтобы в результате имена файлов изменились.
Трепещу перед макросами (да и Касперский не советует)[уже терял не один ТБайт]
Неужели все усилия Советской власти напрасны? Ведь мы ещё не всё взяли, что нам да Октябрь!

С уважением, Суворов Александр Васильевич

Обсуждение

давно

Асмик Гаряка

Профессор
230118
3054

10.01.2010, 19:03

общий

Suvorov:
[offtop]Это загадочная армянская душа.[/offtop]

Неизвестный

10.01.2010, 19:19

общий

Дорогая Асмик, я Вам дам 5 золотых (выручил за Азбуку)
Откройте тайну ячейки Excel, которая творит чудеса с именами файлов.

Неизвестный

10.01.2010, 19:30

общий

Suvorov:
насколько я понял, Вам нужно, чтобы было следующее:
два столбца - первый (для примера) содержит старое имя файла, а второй - новое имя файла
одна кнопка по нажатию которой все файлы с именами как в первом столбце становятся файлами с именами как во втором столбце
ну, и плюс небольшое дополнение, чтобы адекватно реагировать на ошибки в именах файлов (мало ли... а так вместо тупой остановки работы кода с ошибкой будет какое-то действие, которое даст Вам понять, что имя файла в такой-то строке ошибочно...) например, удачные файлы выделять в таблице зеленым цветом, а неудачные - красным, ну и сообщение в конце работы кода, что все прошло удачно или какие-то ошибки все же есть

давно

Megaloman

Модератор
137394
1850

10.01.2010, 20:09

общий

Suvorov:
Итак, смысл задания:
В столбце таблицы начиная с некоторой клетки содержится список полных имен файлов (то есть имя файла с полным путём). Сразу же вопрос:

c таблицей содержащей пути и имена файлов наименований книг.
Содержимое столбца выглядит так:
C:\! Skan\! UzA\БМП-2. Боевая машина пехоты БМП-2. ТО и ИЭ. Часть 1. 1987(djvu)

Но это ведь, похоже, не совсем название файла,
C:\! Skan\! UzA\ - это понятно, это путь к файлу,
БМП-2. Боевая машина пехоты БМП-2. ТО и ИЭ. Часть 1. 1987 это что, название файла? А расширение файла что, обязательно будет в скобках? Или имя файла будет без расширения, как у Вас написано? Чтобы что-то делать с файлом, надо чётко знать название. Что вы подразумеваете под именем файла.
Какие расширения файлов возможны (или заранее все возможные типы файлов неизвестны?)

Имена файлов в столбце идут непрерывно? Пустая клетка в этом столбце обозначает конец списка?
В другом столбце начиная с некоторой клетки содержатся полные пути переименованных файлов, при этом пути файлов совпадают, имена отличаются. В каком виде будет выглядеть изменённое имя?
Готов решить задание с помощью макроса при чёткой постановке.
Просматривается решение и без макроса, при наличии корректных имён файлов в клетках и FAR-менеджера.

Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет

Неизвестный

10.01.2010, 20:16

общий

Представьте себе:

Отсканировал сотню книжек.
Их JPGи лежат в папке с именем книги.
Например:
C:\! Skan\! Uzze otdal\Как пить каждый день, курить, трахаться с кем попало, перестать беспокоиться и располагать к себе людей. Москва. Кремль. 1967.djvu
Выложил в Интернет. Наблюдаю как народ расхватывает примеры хорошего тона.
Сижу, курю.
И вдруг дают ссылку на файлообменник, что есть НОВАЯ редакция:
Как пить каждый день, курить, трахаться с кем попало, перестать беспокоиться и располагать к себе людей.Пособие для офицеров. Издание 2
. 1982.djvu
Качаю с рапиды(туды её в качель)
Вижу, хлопец назвал архив "Хиба хочеш - мусыш"
Вижу, что речь идет об одной важной, насущной теме, но располагаться файлы будут в разных концах списка...
И добросовестные пользователи, вместо того, чтобы добирать культуру - будут метаться по HDD сопоставляя содержимое.
Запускаю BAT-программу в директории своего собрания.
Имею xls-файл-перечень своих файлов с путями и именами.
Запускаю BAT-программу в директории файлов-корреспондентов.
Имею xls-файл-перечень чужих файлов с путями и именами.
Свожу всё в одну EXCEL-таблицу.

Имею в столбце A ячейки с путями-именами своих файлов. Пример: C:\! Skan\! Uzze otdal\Как пить каждый день!.djvu
В столбце В ячейки с путями-именами чужих файлов. Пример: C:\! Skan\Чужие\Хиба хочеш - мусыш.djvu
Редактирую значения в ячейки В на: C:\! Skan\Чужие\Как пить каждый день!=дважды.djvu
А дальше начинается шаманство. Игнорирую Касперского.
Мечта:
Копирую в столбцы/строки некие формулы и после ?нажатия? на что-то - имена файлов(папок) в исходной директории чужих файлов начинают соответствовать ячейке В.
Сижу, курю, думаю о превратностях судьбы...(туды её в качель)

давно

Асмик Гаряка

Профессор
230118
3054

10.01.2010, 20:40

общий

Suvorov:
[offtop]Люблю рассылку БЕЙСИК...Все посетители юмористы.[/offtop]

Неизвестный

10.01.2010, 20:52

общий

Suvorov:
есть одна небольшая проблема: если Вы меняете значение в ячейке на желаемое имя файла, то макросу неоткуда взять начальное имя файла, чтобы найти его и переименовать в желаемое.

могу предложить такой вариант:
столбец 1 - имена ваших файлов (видимо они нужны для удобства именования чужих файлов, и в коде их использовать не предполагается)
столбец 2 - текущие имена чужих файлов
столбец 3 - желаемые имена чужих файлов
кнопка, которая меняет имена файлов из столбца 2 на значения из столбца 3 и выполняет прочее "шаманство"

Неизвестный

10.01.2010, 20:55

общий

Дрож по телу.
Я после того, как спаял вместе с товарищем Зоновым (автором "ленинградского" Спектрума) по журналу РАДИО "компьютера" РК-86 осваивал DOS.
Нортон поддался.
Замучил AUTOEXEC.BAT, CONFIG.SYS.
HIMEM добил меня.
Сочетание символов "FAR"- вызывает легкий ужас.
Неужели придётся подняться до Ассемблера?
Я тихий старичёк, собираю-покупаю военно-техническую литературу.
Сканирую в JPGи.
Выкладываю в DJVU.
Верю в молодёжь с её напором.
В голове не укладывается, что при необходимости переименовывать большой пучек файлов из среды Excel, требуется освоить VBA до тонкостев.
Куда смотрел Центральный Комитет?

давно

Асмик Гаряка

Профессор
230118
3054

10.01.2010, 21:04

общий

Suvorov:
Не бойтесь FAR. Это тот же Нортон, который замаскировался.

Неизвестный

10.01.2010, 21:04

общий

Цитата: 161519

[q=161519]могу предложить такой вариант:
столбец 1 - имена ваших файлов (видимо они нужны для удобства именования чужих файлов, и в коде их использовать не предполагается)
столбец 2 - текущие имена чужих файлов
столбец 3 - желаемые имена чужих файлов
кнопка, которая меняет имена файлов из столбца 2 на значения из столбца 3 и выполняет прочее "шаманство"

[/q]

Батюшка!
Ядрёна сила!
Лучше сформулировать задачу не смог бы и Гейтс!

Буду сидеть на своем 21 этаже, смотреть в окошко на ночной Питер и жать на кнопку "обновить" форум
Уповаю на Вас, уважаемый Vasiliy83!

Неизвестный

10.01.2010, 21:13

общий

Спасибо, уважаемая Асмик!
Безоговорочно верю в QBasic!
Нортон, DOS 6.22 - музыка для души.
Вы бы видели "Спектрум" с его возможностью расцвечивать имена программ...

давно

Megaloman

Модератор
137394
1850

10.01.2010, 21:50

общий

Suvorov:
Что-то тяжело доходит.
Я понимаю как написано: данные в столбцах.
Пытаюсь точнее сформулировать Вашу задачу.

Содержимое столбца A выглядит так (столбец A строки 1,2,3, и т д, то есть ячейки A1 A2 A3) - столбец A1, как Вы пишите, за пределами моего понимания.

Ячейка A1 C:\! Skan\! Uzze otdal\Как пить каждый день!.djvu
Ячейка A2 C:\! Skan\! Uzze otdal\БМП-2. Боевая машина пехоты БМП-2. ТО и ИЭ. Часть 1. 1987.djvu
Ячейка A3 C:\! Skan\! Uzze otdal\Для тех кто в танке.pdf

Содержимое столбца B выглядит так (столбец B строки 1,2,3, и т д, то есть ячейки B1 B2 B3) - столбец A2, как Вы пишите, за пределами моего понимания.

Ячейка B1 C:\! Skan\Чужие\Хиба хочеш - мусыш.djvu
Ячейка B2 C:\! Skan\Чужие\Боевая машина пехоты БМП-2. Часть 1. 1987.djvu
Ячейка B3 C:\! Skan\Чужие\Для умников в танке и БТР.pdf

Насколько я понимаю, Вы хотите переименовать чужие файлы. Вы это делаете вручную в клетках.
Но, чтобы переименовать файл, надо иметь его первоначальное название и изменённое название.
То есть, могу предположить, надо столбец B скопировать, например, в C и уже там корректировать имена файлов.

Содержимое столбца C выглядит так (столбец C строки 1,2,3, и т д, то есть ячейки C1 C2 C3)

Ячейка С1 C:\! Skan\Чужие\Как пить каждый день!=дважды.djvu
Ячейка С2 C:\! Skan\Чужие\БМП-2. Боевая машина пехоты БМП-2. ТО и ИЭ. Часть 1. 1987=пятерижды.djvu
Ячейка С3 C:\! Skan\Чужие\Для тех кто в танке=трижды.pdf

Я правильно понимаю задачу?

Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет

Неизвестный

10.01.2010, 23:19

общий

Разрешите вмешаться в вашу беседу.

Способ, который однозначно убережет данные от потери.
Необходимо перед тестированием программы переименования файлов, скопировать эти файлы на чистый HDD, остальные HDD временно отключить от компьютера, оставив только системный и тестовый.
Далее запускаем программу переименования и смотрим результат, если что-то не работает, то даже если данные удалились, то нам их не жаль, т.к. исходные файлы у нас сохранены на отключенных ранее HDD, а если все получилось, то даже в этом случае нет необходимости использовать исходные файлы для переименования.
Также копируем файлы на новый (чистый) HDD и запускаем программу.
Преимущество в том, что даже если программа зависнет на полпути, всегда можно найти ошибку, отладить и запустить снова.
И самое главное - данные при этом не теряются.

давно

Megaloman

Модератор
137394
1850

10.01.2010, 23:19

общий

это ответ

Здравствуйте, Suvorov. Вот ответ без макросов и VBA.
Таблица с примером, который соответствует постановке задачи, как я её сформулировал в минифоруме, можно взять здесь V_tanke.xls (15.5 кб).
Смысл решения: имеем исходные имена файлов в одном столбце (например, первое имя в ячейке B1), изменённые - в другом (например, первое имя в ячейке C1), тогда в ячейке D1 напишем формулу, генерирующую DOS-команду перемещения файла (здесь это будет равносильно переименованию, если путь один и тот же):

="move " & """" & B1 & """ """ & C1 & """"

Размножим формулу на остальные ячейки.
Выкачаем текстовый редактор AkelPad вот здесь. Распакуем полученный файл, получим akelpad.exe. Запустим его. Переключимся в Excel-таблицу. Выделим и скопируем сгенерированные Dos-команды в столбце D и вставим в редактор AkelPad. В меню Кодировки этого редактора выбирем Сохранить в DOS-866, сохраним полученное в Bat-файл, например rrrr.bat
Закрываем AkelPad, запускаем полученный батник. Всё! Могу изобразить и макрос, но Вам так этого не хотелось ...

Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет

давно

Асмик Гаряка

Профессор
230118
3054

10.01.2010, 23:39

общий

Megaloman:
Зачем нужен AkelPad? Сам Эксель не может экспортировать в текстовый файл? Или кодировка потеряется?

Неизвестный

10.01.2010, 23:54

общий

Цитата: 399

Способ, который однозначно убережет данные от потери

Благодарю Вас за ценный совет.
Я не успеваю "скопировать эти файлы на чистый HDD"
Информация валится на меня ежеминутно.

давно

Megaloman

Модератор
137394
1850

11.01.2010, 00:52

общий

Сам Эксель может экспортировать в текстовый ДОС-файл. Но у меня почему-то криво получилось - для батника не годится.

Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет

Неизвестный

11.01.2010, 01:02

общий

Уже хорошо!

Неизвестный

11.01.2010, 10:02

общий

Suvorov:
не успел еще посмотреть решение уважаемого Megaloman, в течение дня обязательно гляну
если в моем варианте будут какие-то принципиальные отличия, то выложу и свое в дополнение к его ответу

давно

Megaloman

Модератор
137394
1850

11.01.2010, 20:47

общий

Можно еще приделать в команде ключ move /Y но не знаю, нужно ли ...
="move /Y " & """" & B1 & """ """ & C1 & """"

Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет

давно

Megaloman

Модератор
137394
1850

11.01.2010, 21:00

общий

Vasiliy83:
Принципиально другое - вот макрос, но клиент его не хотел, хоть вопрос и в VBA. При переименовании, если имя уже есть в указанном пути, переименование не состоится. Не знаю, что надо клиенту, возможно, стоило бы заставить всё-таки перезаписаться файлу.

Код:

Beg_R = "B1"                  ' Начальная клетка с чужими именами
List_N = "Лист1"
Set FSO = CreateObject("Scripting.FileSystemObject")

i = 0
F_From = Sheets(List_N).Range(Beg_R).Value

On Error Resume Next
While Len(Trim(F_From)) <> 0
    F_To = Sheets(List_N).Range(Beg_R).Offset(i, 1).Value
    
'    MsgBox F_From
'    MsgBox F_To
    
    FSO.MoveFile F_From, F_To
    i = i + 1
    F_From = Sheets("Лист1").Range(Beg_R).Offset(i, 0).Value
Wend

Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет

Неизвестный

19.01.2010, 00:43

общий

Эта вещь работает.
Хочу модифицировать.
Если не сложно, то добавьте комментарии в макросе, пожалуйста.

давно

Megaloman

Модератор
137394
1850

19.01.2010, 11:27

общий

Вот макрос с комментариями. Напоминаю, что при переименовании, если имя уже есть в указанном пути, переименование не состоится. Не знаю, что Вам надо, возможно, стоило бы заставить всё-таки перезаписаться файлу.

Код:


'  В столбце, начиная с некоторой клетки, записаны полные имена файлов (путь+имя)
'  В соседних клетках справа - полные изменённые имена файлов (путь+имя), путь должен быть созданным ранее. 
'  Путь в изменённом имени не обязательно = исходному пути, но путь реально должен существовать.
 
Beg_R = "B1"                  ' Начальная клетка с исходными полными именами файлов
List_N = "Лист1"             ' Имя листа с именами файлов

Set FSO = CreateObject("Scripting.FileSystemObject")

i = 0
F_From = Sheets(List_N).Range(Beg_R).Value                             ' Читаем содержимое самой первой клетки с исходными именами

On Error Resume Next                                                                  ' Обработка возможных ошибок при переносе файлов
While Len(Trim(F_From)) <> 0                                                      ' Организуем цикл до тех пор пока в клетках для исходных имён не пусто. 
    F_To = Sheets(List_N).Range(Beg_R).Offset(i, 1).Value           '  Читаем в правой от исходной изменённое имя файла
    
'    MsgBox F_From
'    MsgBox F_To
    
    FSO.MoveFile F_From, F_To                                                      '  Перемещаем файл с исходным путём в изменённый
    i = i + 1                                                                                     '  Наращиваем номер строки
    F_From = Sheets("Лист1").Range(Beg_R).Offset(i, 0).Value    '  Читаем следующее исходное имя файла
Wend

Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет

Неизвестный

19.01.2010, 12:54

общий

В каком смысле "перезаписаться файлу"?

Имеется коллекция книг.
Имеются их копии в электронном виде.

Часть их представляет файлы сканов страниц (имена файлов не имеют значения)
Эта группа файлов лежит в ПАПКЕ с ИМЕНЕМ книги

Другая часть уже переработана в PDF, DJVU и имена файлов соответствуют названиям книг.
И тем не менее, каждый PDF, DJVU файл (даже если он один) помещен в папку с соответствующим именем

Не все создатели электронных копий утруждают себя присвоением имени файла(папки) в соответствии с названием книги.
Одна и та же книга может иметь несколько вариантов в электронном виде и:
состоять из растровых файлов
состоять из DOC файлов
отсканирована с различным разрешением и цветом
быть PDF-документом
Быть DJVU-документом

Необходимо сохранить все варианты электронного вида книги, но присвоить ПАПКАМ соответствующие имена. Копии - удалить вручную.

Идея в том, что:
Имею несколько списков содержимого папок из разных уголков HDD.
Свожу в одну EXCEL таблицу.
Копирую содержимое столбца "В" в столбец"С"
Манипулирую с содержимым ячеек столбца "С"
Ищу подобие по разным признакам.
Обнаруживаю одинаковые файлы (папки) и привожу их имена в в соответствие c названием книги.
Призываю уважаемый, но таинственный макрос и имена файлов|папок на диске начинают соответствовать именам (и путям) указанным в столбце "С"

Конечно, если происходит ПЕРЕМЕЩЕНИЕ в соответствии с путями столбца "С", то жизнь кажется малиной!

давно

Megaloman

Модератор
137394
1850

19.01.2010, 14:12

общий

Suvorov:
Происходит перемещение файла с полным именем из столбца B в файл с полным именем столбца C. Если пути файлов совпадают, то это по результату эквивалентно переименованию. Вам что, нужно чтобы конечная папка создавалась сама?

Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет

давно

Megaloman

Модератор
137394
1850

19.01.2010, 18:07

общий

Suvorov:

В каком смысле "перезаписаться файлу"?

Допустим, исходный файл имеет имя C:\Путь\Файл.pdf.
Вы его хотите переместить в файл C:\Путь2\Файл_дубль.pdf.
Мой макрос отработает нормально, если файла C:\Путь2\Файл_дубль.pdf до запуска макроса не было. При этом исходный файл C:\Путь\Файл.pdf будет перемещен в C:\Путь2\Файл_дубль.pdf
Если же файл C:\Путь2\Файл_дубль.pdf до запуска макроса уже был, то он перезаписан заново не будет и файл C:\Путь\Файл.pdf останется на месте необработанным.
Можно, конечно, организовать перезапись файла ...

Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет

давно

Megaloman

Модератор
137394
1850

19.01.2010, 20:51

общий

Вот макрос который берёт в клетке исходное полное имя файла, в соседней клетке берёт полное имя файла куда переместить исходный файл.
Выходная директория может предварительно и не существовать - макрос создаст
Режим перезаписи выходного файла может быть настроен в параметре вверху макроса
Правее клетки с именем выходного файла поместим результат выполнения операции.
Описания - по тексту макроса.
Таблицу с примером возьмите здесь Perenos_failov_iz_spiska_v_tab.xls (38.0 кб)

Код:

Sub MoveFile()
'  В столбце, начиная с некоторой клетки, записаны полные имена файлов (путь+имя)
'  В соседних клетках справа - полные изменённые имена файлов (путь+имя)
'  Путь в изменённом имени не обязательно = исходному пути.
 
 
Beg_R = "B5"                  ' Начальная клетка с исходными полными именами файлов
List_N = "Лист2"              ' Имя листа с именами файлов
Perezap = True                ' Разрешение на перезапись выходного файла

Set FSO = CreateObject("Scripting.FileSystemObject")

i = 0
F_From = Sheets(List_N).Range(Beg_R).Value                          ' Читаем содержимое самой первой клетки с исходными именами

While Len(Trim(F_From)) <> 0                                        ' Организуем цикл до тех пор пока в клетках для исходных имён не пусто.
    F_To = Sheets(List_N).Range(Beg_R).Offset(i, 1).Value           '  Читаем в правой от исходной изменённое имя файла
    
'    MsgBox F_From
'    MsgBox F_To
    
    Sheets(List_N).Range(Beg_R).Offset(i, 2) = MakeFolders(F_From, F_To, Perezap, FSO)     ' Перемещаем файл с исходным путём в изменённый
    i = i + 1                                                                              '  Наращиваем номер строки
    F_From = Sheets(List_N).Range(Beg_R).Offset(i, 0).Value                    '  Читаем следующее исходное имя файла
Wend

End Sub

Function MakeFolders(InPath, OutPath, iReplace, FSO)
'  InPath - полное имя исходного файла (Диск:\Путь\файл)
'  OutPath - полное имя перенесённого файла
'  iReplace - =True если надо перезаписать файл OutPath при его наличии, иначе = False
'  FSO - объект FileSystemObject
' Функция возвращает значение "Не удалось", если файл не удалось переместить, иначе "Ok"

MakeFolders = "Не удалось"

iii = Trim(OutPath)

If iReplace Then
    If FSO.FileExists(iii) Then     ' Если файл уже есть и iReplace=true, его удаляем
        FSO.DeleteFile iii, True
    End If
End If

Mass = Split(iii, "")                      ' Разбиваем в массив полный путь для выходного файла на состовляющие
Niii = UBound(Mass)

TekDir = Mass(0)
On Error Resume Next            ' Обработка возможных ошибок при переносе файлов

If Niii >= 2 Then
    For jjj = 1 To Niii - 1                 ' Если надо, создадим выходную директорию
        TekDir = TekDir + "" + Mass(jjj)
'         MsgBox TekDir
        If Not FSO.FolderExists(TekDir) Then
            FSO.CreateFolder TekDir
        End If
    Next
End If
    
FSO.MoveFile InPath, OutPath
If Err.Number = 0 Then MakeFolders = "Ok"

On Error GoTo 0

End Function

Внимание!!! Сообщение редактировалось в 22-20 МСК в коде макроса

Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет

Неизвестный

20.01.2010, 01:29

общий

Спасибо, всё работает.
Одна беда - списки большие - сортировать приходиться по многим параметрам (у меня 10 столбцов)
Прошу прощения.
Добавить бы ещё один столбец, чтобы указывать (символом, допустим "+") какие строки (папки-файлы) переименовывать
Изначально я этот столбец заполню символами "-"
Отсутствие в ячейке символа будет означать для макроса - конец работы.
Тогда будет возможно перемежать работу по редактированию фрагмента списка с работой макроса.

С уважением, Александр

давно

Megaloman

Модератор
137394
1850

20.01.2010, 11:45

общий

Внимание!!! В предыдущем решении при возможности перезаписи файлов возможно будут потеряны изменённые файлы, если есть указание на исходные файлы, которых реально уже нет. Вот макрос, который устраняет этот недочет и решает Ваше последнее пожелание

Код:

Sub MoveFile()
'  В столбце, начиная с некоторой клетки, записаны полные имена файлов (Диск:\Путь\файл)
'  В соседних клетках справа - полные изменённые имена файлов
'  Путь в изменённом имени не обязательно = исходному пути.
'  Переносим исходные файлы в файлы с изменённым именем
'  В соседней клетке, содержащей изменённое имя, после перемещения, записываем результат операции ("Ok" или "Не удалось")
'  При повторном запуске макроса клетки, для которых в столбце результата выполнения не пусто, не обрабатываются
 
 
Beg_R = "B5"                  ' Начальная клетка с исходными полными именами файлов
List_N = "Лист2"              ' Имя листа с именами файлов
Perezap = True                ' Разрешение на перезапись выходного файла

Set FSO = CreateObject("Scripting.FileSystemObject")

i = 0
F_From = Sheets(List_N).Range(Beg_R).Value                          ' Читаем содержимое самой первой клетки с исходными именами

While Len(Trim(F_From)) <> 0                                        ' Организуем цикл до тех пор пока в клетках для исходных имён не пусто.
    F_To = Sheets(List_N).Range(Beg_R).Offset(i, 1).Value           '  Читаем в правой от исходной изменённое имя файла
    
'    MsgBox F_From
'    MsgBox F_To
    
    If Trim(Sheets(List_N).Range(Beg_R).Offset(i, 2)) = "" Then Sheets(List_N).Range(Beg_R).Offset(i, 2) = MakeFolders(F_From, F_To, Perezap, FSO)   ' Перемещаем файл с исходным путём в изменённый
    
    i = i + 1                                                                              '  Наращиваем номер строки
    F_From = Sheets(List_N).Range(Beg_R).Offset(i, 0).Value                    '  Читаем следующее исходное имя файла
Wend

End Sub

Function MakeFolders(InPath, OutPath, iReplace, FSO)
'  InPath - полное имя исходного файла (Диск:\Путь\файл)
'  OutPath - полное имя перенесённого файла
'  iReplace - =True если надо перезаписать файл OutPath при его наличии, иначе = False
'  FSO - объект FileSystemObject
' Функция возвращает значение "Не удалось", если файл не удалось переместить, иначе "Ok"

MakeFolders = "Не удалось"

iii = Trim(OutPath)

If iReplace Then
    If FSO.FileExists(iii) Then     ' Если файл уже есть и iReplace=true, его удаляем
        If Trim(FSO.FileExists(InPath)) Then FSO.DeleteFile iii, True
    End If
End If

Mass = Split(iii, "")                      ' Разбиваем в массив полный путь для выходного файла на состовляющие
Niii = UBound(Mass)

TekDir = Mass(0)
On Error Resume Next            ' Обработка возможных ошибок при переносе файлов

If Niii >= 2 Then
    For jjj = 1 To Niii - 1                 ' Если надо, создадим выходную директорию
        TekDir = TekDir + "" + Mass(jjj)
'         MsgBox TekDir
        If Not FSO.FolderExists(TekDir) Then
            FSO.CreateFolder TekDir
        End If
    Next
End If
    
FSO.MoveFile InPath, OutPath
If Err.Number = 0 Then MakeFolders = "Ok"

On Error GoTo 0

End Function

Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет

давно

Megaloman

Модератор
137394
1850

20.01.2010, 15:14

общий

Suvorov:
Perenos_failov_iz_spiska_v_tab.xls (38.0 кб) -можно скачать

Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет

Форма ответа

Отправка постов/ответов доступна только зарегистрированным и подтвержденным пользователям.

Если Вы уже зарегистрированы на Портале - войдите в систему, если Вы еще не регистрировались - пройдите простую процедуру регистрации.