Уважаемые форумчане, помогите разобраться. Имеются файлы с названиями Число1_Число2_Число3.xls в папке. Необходимо сделать макрос, чтобы из определенного файла Excel Название.xls в названиях файлов в папке он массово переименовывал Число1, Число2, Число3 в названиях файлов в соответствующее значение из таблицы файла Название.xls.
Без VBA не обойтись. В нашем случае можно воспользоваься, к примеру, методом movefile объекта filesystemobject. Делаем цикл над файлами, которые хотим переименовать, и используем означенный выше метод. Удачи.
Что только я не делал все эти дни, ничего не получается. Может кто поможет. Я несколько иначе сформулирую задачу, которая предстала передо мной.
Имеются файлы Excel в некоторой папке. Названия их разные и пусть ценности не представляют. Необходимо переименовать каждый файл с учётом внутренней информации каждого из этих них. Например, в каждом файле имеется разная информация в ячейках А2, А10. Нужно, чтобы каждый файл поменял имя на то, что у него содержится в указанных ячейках. То есть все файлы с названием Кракозябра.xls должны теперь именоваться как А2А10.xls
В VBA старательно учусь и, поэтому прошу подоступнее объяснить. Надеюсь на понимание.
Ну так приложите файл с теми кодами, которые получились самостоятельно, пусть и не рабочие. Пока никаких попыток изучить VBA не видать. Видно только попытки получить готовое решение.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Sub jjj()
Dim strPathFrom$, strPatternName$, strFileName$, strFileNewName$
Const strD3 = "D3"
Const strD12 = "D12"
Const strWRONG_SYMB_PATTERN$ = "[\\\/\:\*\?\""\<\>\|\[\]]+" _
' шаблон недопустимых символов в имени файла, которые подлежат замене/удалению
strPathFrom = "C:\Полигон" & "\"
strPatternName = "*.xlsx"
strFileName = Dir(strPathFrom & strPatternName)
While Len(strFileName) > 0
strFileName = strPathFrom & strFileName
With GetObject(strFileName)
With .Worksheets(1)
strFileNewName = strPathFrom & strReplace(.Range(strD3).Value & " " & .Range(strD12).Value, _
strWRONG_SYMB_PATTERN, "")
End With
.Close
End With
With CreateObject("Scripting.FileSystemObject")
strFileNewName = strFileNewName & "." & .GetExtensionName(strFileName)
If strFileName <> strFileNewName Then .MoveFile strFileName, strFileNewName
End With
strFileName = Dir
Wend
End Sub
Public Function strReplace$(strStr$, strPattern$, strReplacement$)
With CreateObject("VBScript.RegExp")
.Pattern = strPattern
strReplace = strStr
While .test(strReplace)
strReplace = .Replace(strReplace, strReplacement)
Wend
End With
End Function
Путь задайте свой.
Формула массива (ФМ) вводится Ctrl+Shift+Enter Memento mori
Имеется такая проблема при реализации этой идеи у меня. Дело в том, что файлы, которые изначально выгружаются для переименования, при открытии выдают сообщение: "Формат файла не соответствует разрешению файла". Лечу это всегда просто нажатием на "Сохранить как" и сохраняю опять с тем же именем, с тем же расширением, и потом файл нормально открывается. Можно ли в этой связи как-нибудь прикрутить что-нибудь, чтобы перед переименованием все файлы были пересохранены с тем же названием и расширением? Файл с сообщением, которое выдается, прикладываю. Спасибо.