Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Переименование файлов из одной папки по списку
 
#1
26.10.2017 08:56:37
Коллеги, товарищи, друзья! 8)
Перекопав бессчетное количество странице Интернета, израсходовав тонный мегабайт трафика, общаясь с полуботами полулюдьми - я всё равно вернулся сюда к Вам за советом. :oops:
Итак, существует задача - переименовать 380 файлов, лежащих в одно папке, согласно списку Excel.
Данная тема уже не раз обсуждалась на просторах нашего Форума, но (как это бывает обычно) что-то не срастается.
Значицо, повторюсь ещё раз, есть задача:
- Переименовать 380 PDF файлов, согласно списку Excel.
- Файлы имеют имя от 1 до 380
- Я так понимаю, что нужно использовать что-то типа NewName OldName
Схожая тема была тут: http://www.planetaexcel.ru/forum/?PAGE_NAME=read&FID=1&TID=47869 - но не вышло что-то (постоянная ошибка Runtime error 52 или 53). "Я ж не программист" (с)
На всякий случай контролвэшню код с прошлой темы (я думаю, что из неё можно что-то сделать):
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Option Explicit
Sub ПереименоватьГруппуФайлов()
Dim OldName As String, NewName As String, sPath As String
Dim i As Long, lLastRow As Long
sPath = "C:\1\"
lLastRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = 1 To lLastRow
OldName = sPath & Cells(i, 1) & ".jpg" 'старое имя в ячейке
NewName = sPath & Cells(i, 2) & ".jpg" 'новое имя
Name OldName As NewName
Next i
End Sub
  
Private Sub CommandButton1_Click()
Dim OldName As String, NewName As String, sPath As String
Dim i As Long, lLastRow As Long
sPath = "C:\1\"
lLastRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = 1 To lLastRow
OldName = sPath & Cells(i, 1) & ".jpg" 'старое имя в ячейке
NewName = sPath & Cells(i, 2) & ".jpg" 'новое имя
Name OldName As NewName
Next i
End Sub

Верю, надеюсь и жду от вас информации по поводу данной ситуации.

Всем мира и добра!
Изменено: User_abc - 04.02.2020 00:43:36
 
 
 
#2
26.10.2017 09:05:30
Так с кодом всё в порядке. Ну если не считать что опубликован не по правилам...
 
 
 
#3
26.10.2017 09:09:16
User_abc,И что вам нужно ответить? Абсолютно рабочий код.  :) Ток непонятно зачем 2 раза его записывать, как и написали в теме по той ссылке которую приводите.
 
 
 
#4
26.10.2017 09:15:39
Пробовал и так и сяк с файлами 1 и 2 jpg из архива автора. Не получается. Ошибка постоянно. Runtime error 52

Цитата
Александр П. написал: зачем 2 раза его записывать, как и написали в теме по той ссылке которую приводите.
Уважаемый Александр!
Скопировано было с предыдущей темы.

По поводу настоящей ситуации. Я так понимаю, что нужно поменять (если работать с кнопкой)
Код
?
1
2
3
4
5
6
7
8
9
10
11
Private Sub CommandButton1_Click()
Dim OldName As String, NewName As String, sPath As String
Dim i As Long, lLastRow As Long
sPath = "C:\1\"
lLastRow = Cells(Rows.Count, 2).End(xlUp).Row
For i = 1 To lLastRow
OldName = sPath & Cells(i, 1) & ".pdf" 'старое имя в ячейке
NewName = sPath & Cells(i, 2) & ".pdf" 'новое имя
Name OldName As NewName
Next i
End Sub
Но раз все говорят, что код рабочий - почему у меня вылазит ошибка, когда я скачал из предыдущей темы архив с файлами - распаковал в папку, описанную в теме, и не работает ничего...
Изменено: User_abc - 17.04.2020 15:54:04
 
 
 
#5
26.10.2017 09:23:56
Значит нет таких файлов. Или нет прав их переименовывать. Что именно означает ошибка 52 - я на память не знаю.
Гугль подсказал:
Цитата
Bad file name or number (Error 52)
А ещё бывало, что пытались переименовать запрещённым именем!
Изменено: Hugo - 04.02.2020 00:46:39
 
 
 
#6
26.10.2017 09:52:23
Скопировал файлы у предыдущего автора. Пробовал на разных компьютерах. Ничего не вышло. Всё размещал в С:\1\
Всё равно Bad file name or number (Error 52). Ничего не понимаю.
 
 
 
#7
26.10.2017 10:01:01
Я пас - запрещено скачивать архивы и файлы с макросами.... :(
 
 
 
#8
26.10.2017 10:06:07
в названиях файлов не должно быть:
/ \ | : * ? и ещё что-то

У меня бывало так:
В ячейке узбекское слово ҚИШ

но VBA читает Қ как ? и пытается дать файлу имя ?ИШ

вот и ошибка
Изменено: Бахтиёр - 26.10.2017 10:07:37
 
 
 
#9
26.10.2017 10:11:35
Мож Вы несколько раз пытаетесь переименовать то, что уже переименовано?
Я сам - дурнее всякого примера! ...
 
 
 
#10
26.10.2017 10:17:57
Цитата
User_abc  Bad file name or number (Error 52).
Как только вылезет эта ошибка нажмите кнопку "Debug", попадёте в окно редактора VBA? ничего не трогая наберите в окне Immediate
Код
?
1
Debug.Print newname
нажмите Enter

Что в результате?
Изменено: Бахтиёр - 26.10.2017 10:19:20
 
 
 
#11
26.10.2017 10:32:10
Попробовал все работает!
В столбце A-наименования файлов существующих
В столбце B-наименования на которые необходимо поменять
И переменную sRath переписал с
Код
?
1
sPath = "C:\1\"
на
Код
?
1
sPath = ThisWorkbook.Path & "\"
Как-то так!
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#12
26.10.2017 11:44:50
Спасибо комрады! Все заработало!

Отдельная респа в карму kuklp
 
 
 
#13
04.02.2020 00:21:52
Доброй ночи, всем!
А можно этот макрос:
Код
?
1
2
3
4
5
6
7
8
9
10
11
Sub www()
    Dim OldName As String, NewName As String, sPath As String
    Dim i As Long, lLastRow As Long
    sPath = ThisWorkbook.Path & "\"
    lLastRow = Cells(Rows.Count, 2).End(xlUp).Row
    For i = 2 To lLastRow
        OldName = sPath & Cells(i, 1) & ".jpg"    'старое имя в ячейке
        NewName = sPath & Cells(i, 2) & ".jpg"    'новое имя
        Name OldName As NewName
    Next i
End Sub
настроить так, чтобы при переименовании в конце добавлял "_1.jpg", "_2.jpg", "_3.jpg", "_4.jpg"... в нужном кол-ве? Например, у меня есть список артикулов и у каждого артикула от 1 до 5-6 фото. Названия фото надо переименовать по артикулу. А так как список из несколько тысяч артикулов, то в ручную подгонять одно на другое думаю не реально. Помогите пожалуйста!
Заранее благодарю за любую помощь!
ПС. для наглядного примера прикрепил тестовый документ, то как выглядит мой список.
Изменено: sovvase - 04.02.2020 00:23:31
 
 
 
#14
04.02.2020 00:48:07
Добавьте свои _1 на листе в Cells(i, 2)
 
 
 
#15
04.02.2020 00:52:52
Hugo,
Извините пожалуйста, а можете для особо тупых и далеких на более человечном языке объяснить, что куда и как?)))
В любом случае спасибо за помощь!)
 
 
 
#16
04.02.2020 00:56:28
Да сразу готовите список нужных новых имён на листе.
 
 
 
#17
04.02.2020 01:00:08
в смысле редактировать в списке где-то так 10-12 тыс повторяющихся по несколько раз артикулов, добавив к каждому соответствующие _1, _2, _3...???
 
 
 
#18
04.02.2020 01:13:01
Да. Самой простой формулой счетесли(), склейка, даблклики. Хоть на миллион за минуту.
Вот, нашёл время. В файле пошагово, но можно всё совместить в одной ячейке, хотя зачем?
Изменено: Hugo - 04.02.2020 01:35:57
 
 
 
#19
04.02.2020 01:37:03
Заменил файл, наверное сперва не те имена были...
 
 
 
#20
04.02.2020 01:38:27
Hugo,
Вы гений!) Спасибо, добрый человек) буду пробовать.
 
 
 
#21
17.04.2020 15:39:12
В общем, неделю назад искал как переименовывать файлы по списку и наткнулся на эту тему. Обрадовался, начал использовать, но на практике постоянно сталкивался с какими-то мелкими проблемами. В итоге пришел вот к такому варианту кода:

Option Explicit
Sub Rename()
On Error Resume Next
Dim OldName As String, NewName As String, sPath As String
Dim i As Long, lLastRow As Long
  sPath = "C:\1\"
  lLastRow = Cells(Rows.Count, "a").End(xlUp).Row
  For i = 2 To lLastRow
     OldName = sPath & Cells(i, "a")
     NewName = sPath & Cells(i, "b")
     Name OldName As NewName
  Next i
  If Err > 0 Then Exit Sub
  On Error GoTo 0
End Sub

Сразу скажу, что я там даже близко не программист, только примерно понимаю, как код работает, опирался на интуицию и просто шел путем перебора вариантов.
Какие тут изменения относительно верхнего кода и почему:
1. Убрал кнопку - мне не нужна, и два одинаковых кода смущают.
2. Переименовал sub - почему-то иногда проблемы с кодировкой при ctrl-v
3. Заменил 1 и 2 на "a", "b" здесь: " sPath & Cells(i, 1) sPath & Cells(i, 2)". Наверное, не обязательно, но мне проще соотносить с колонкой было
4. "lLastRow = Cells(Rows.Count, "a")". Показалось, что с 2 у меня не работало. Заменил на 1, потом на "a", соответственно.
5. Сразу сделал отсчет со второй строки. Как правило, всегда есть подзаголовки.
6. И, самое главное, постоянно вылезали ошибки 53 и 58. Когда работаешь с большим объемом данных, неудобно спотыкаться на каждой строке. Проще потом проверить, что не так. Минус еще в том, что он последовательно обрабатывает строчки и непонятно на какой именно происходит ошибка, а уже переименованные строки он считает ошибочными при повторном запуске. Поэтому погуглил как игнорировать ошибки.

Я понимаю, что как сами изменения, так и мои комментарии для специалиста могут выглядеть также как шаманские рецепты выглядят для врача, но эта система работает, и может кому-то помочь.

С радостью узнаю о возможных неточностях или более эффективных методах решения проблемы.
Изменено: Sharmat - 17.04.2020 19:08:42
 
 
 
#22
17.04.2020 15:43:30
Цитата
Sharmat написал:
чтобы их решить пришел вот к такому варианту кода:
8-0
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#23
17.04.2020 19:23:22
Есть надстройка, упрощающая всю сложность в этом деле до пару кликов мышкой. Да простить меня разраб!)
[spoiler]https://cloud.mail.ru/public/3kuT/4GbhtGqq4[/SPOILER]
инструкции на ютубе.
[spoiler]https://www.youtube.com/watch?v=NGNBTnpLEO0&feature=youtu.be
https://www.youtube.com/watch?v=rBWp7yAP1iI&feature=youtu.be[/SPOILER]
Изменено: sovvase - 17.04.2020 19:51:11
 
 
 
#24
17.04.2020 19:39:21
Обработка ошибок неправильная - какой смысл молча проверять была ли в процессе ошибка? Молча...
Лучше где-то сразу после копирования If Err > 0 Then пишем куда-то эти имена и сбрасываем ошибку - так получите лог работы.
 
 
 
#25
17.04.2020 22:42:34
Так должно отметить ячейки с ошибками
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Rename()
    Dim OldName As String, NewName As String, sPath As String
    Dim i As Long, lLastRow As Long
    sPath = "C:\1\"
    lLastRow = Cells(Rows.Count, "a").End(xlUp).Row
    On Error Resume Next
    For i = 2 To lLastRow
        OldName = sPath & Cells(i, "a")
        NewName = sPath & Cells(i, "b")
        Name OldName As NewName
        If Err > 0 Then Cells(i, "a").Interior.Color = vbRed: Err.Clear
    Next i
End Sub
"Все гениальное просто, а все простое гениально!!!"
 
 
 
#26
18.04.2020 11:55:53
Nordheim,Отлично работает!
Еще заменил

If Err > 0 Then Cells(i, "a").Interior.Color = vbRed: Err.Clear

на

If Err.Number = 58 Then Cells(i, "a").Interior.Color = vbRed: Err.Clear
If Err.Number = 53 Then Cells(i, "a").Interior.Color = vbBlue: Err.Clear

Мне удобно, но я думаю, для чистоты нужно что-то добавить для других ошибок.  
 
 
 
Страницы: 1
Читают тему
Loading...