Макрос для переименования файлов в excel

Хитрости »

15 Август 2012              129965 просмотров


В этой статье я хотел бы рассказать как средствами VBA переименовать, переместить или скопировать файл. В принципе методы переименования, перемещения и копирования, так сказать, встроены в VBA. Это значит что можно без вызова сторонних объектов переименовать, переместить или копировать любой файл. Все это делается при помощи всего двух команд: FileCopy и Name [Исходный файл] As [Новый файл]. Притом команда FileCopy выполняет только копирование, а Name [Исходный файл] As [Новый файл] — как переименование, так и перемещение. Разница лишь в том, что при переименовании мы указываем только новое имя файла, а при перемещении — другую директорию(папку), в которую следует переместить файл. Плюс рассмотрим пример удаления файла.
Так же разберем методы копирования, перемещения, переименования и удаления файлов и папок через библиотеку FileSystemObject (FSO).

Работа с файлами встроенными командами VBA

  • Копирование файла
  • Перемещение файла
  • Переименование файла
  • Удаление файла

Работа с файлами через объект FileSystemObject (FSO)

  • Копирование файла
  • Перемещение файла
  • Переименование файла
  • Удаление файла

Работа с папками через объект FileSystemObject (FSO)

  • Копирование папки
  • Перемещение папки
  • Переименование папки
  • Удаление папки

Во всех примерах работы с файлами встроенными функциями будет присутствовать проверка на наличие файла по указанному пути. Делать это будем при помощи встроенной функции Dir([PathName],[Attributes]).
PathName — указывается полный путь к файлу
Attributes — указывается признак свойств файла. Вообще их несколько(скрытый, архивный и т.п.), но нас для наших задач будет интересовать пока только один: 16(vbDirectory). Он отвечает за проверку папок и файлов без специальных свойств(т.е. не архивные, не скрытые и т.д.). Хотя по сути его можно вообще не указывать, и тогда будет по умолчанию применен атрибут 0(vbNormal) — проверка файлов без определенных свойств. Ни в том ни в другом случае ошибкой это не будет.

Sub Copy_File()
    Dim sFileName As String, sNewFileName As String
 
    sFileName = "C:WWW.xls"    'имя файла для копирования
    sNewFileName = "D:WWW.xls"    'имя копируемого файла. Директория(в данном случае диск D) должна существовать
    If Dir(sFileName, 16) = "" Then 
        MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru"
        Exit Sub
    End If
 
    FileCopy sFileName, sNewFileName 'копируем файл
    MsgBox "Файл скопирован", vbInformation, "www.excel-vba.ru"
End Sub
Sub Move_File()
    Dim sFileName As String, sNewFileName As String
 
    sFileName = "C:WWW.xls"    'имя исходного файла
    sNewFileName = "D:WWW.xls"    'имя файла для перемещения. Директория(в данном случае диск D) должна существовать
    If Dir(sFileName, 16) = "" Then 
        MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru"
        Exit Sub
    End If
 
    Name sFileName As sNewFileName 'перемещаем файл
    MsgBox "Файл перемещен", vbInformation, "www.excel-vba.ru"
End Sub
Sub Rename_File()
    Dim sFileName As String, sNewFileName As String
 
    sFileName = "C:WWW.xls"    'имя исходного файла
    sNewFileName = "C:WWW1.xls"    'имя файла для переименования
    If Dir(sFileName, 16) = "" Then 
        MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru"
        Exit Sub
    End If
 
    Name sFileName As sNewFileName 'переименовываем файл
 
    MsgBox "Файл переименован", vbInformation, "www.excel-vba.ru"
End Sub
Sub Delete_File()
    Dim sFileName As String
 
    sFileName = "C:WWW.xls"    'имя файла для удаления
 
    If Dir(sFileName, 16) = "" Then 
        MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru"
        Exit Sub
    End If
    Kill sFileName 'удаляем файл
    MsgBox "Файл удален", vbInformation, "www.excel-vba.ru"
End Sub

Как видно ничего сложного.


Так же можно проделать те же операции с файлами при помощи объекта FileSystemObject. Строк кода несколько больше и выполняться операции будут медленнее(хотя вряд ли это будет заметно на примере одного файла). Однако есть существенный плюс — при помощи FileSystemObject можно корректно производить операции с файлами и папками на сетевом диске. Хотя та же

Dir(sFileName, 16)

часто выдает ошибку при работе с сетевыми дисками.
Прежде всего следует, я думаю, пояснить что за зверь такой — FileSystemObject.

FileSystemObject (FSO)

— содержится в библиотеке типов Scripting, расположенной в файле библиотеки scrrun.dll. Объектная модель FSO дает возможность создавать, изменять, перемещать и удалять папки и файлы, собирать о них различную информацию: имена, атрибуты, даты создания или изменения и т.д. Чтобы работать с FSO необходимо создать переменную со ссылкой на объект библиотеки. Сделать это можно двумя способами: через ранее связывание и позднее. Я не буду сейчас вдаваться в подробности этих методов — тема довольно обширная и я опишу её в другой статье.

Ранее связывание:

для начала необходимо подключить библиотеку Microsoft Scripting Runtime. Делается это в редакторе VBA: References-находите там Microsoft Scripting Runtime и подключаете. Объявлять переменную FSO при раннем связывании следует так:

Dim objFSO As New FileSystemObject

Плюсы раннего связывания: с помощью Object Browser можно просмотреть список объектов, свойств, методов, событий и констант, включенных в FSO. Но есть значительный минус: если планируется использовать программу на нескольких компьютерах, то есть большая вероятность получить ошибку(читать подробнее).
Позднее связывание: ничего нигде не надо подключать, а просто используем метод CreateObject(именно этот способ используется мной в примерах ниже). Методы таким образом просмотреть не получится, но зато работать будет без проблем на любых компьютерах без дополнительных действий.

Sub Copy_File()
    Dim objFSO As Object, objFile As Object
    Dim sFileName As String, sNewFileName As String
 
    sFileName = "C:WWW.xls"    'имя исходного файла
    sNewFileName = "D:WWW.xls"    'имя файла для переименования
    'создаем объект FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'проверяем наличие файла по указанному пути
    If objFSO.FileExists(sFileName) = False Then 
        MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru"
        Exit Sub
    End If
    'копируем файл
    Set objFile = objFSO.GetFile(sFileName)
    objFile.Copy sNewFileName
 
    MsgBox "Файл скопирован", vbInformation, "www.excel-vba.ru"
End Sub
Sub Move_File()
    Dim objFSO As Object, objFile As Object
    Dim sFileName As String, sNewFileName As String
 
    sFileName = "C:WWW.xls"    'имя исходного файла
    sNewFileName = "D:WWW.xls"    'имя файла для переименования
    'создаем объект FileSystemObject    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'проверяем наличие файла по указанному пути
    If objFSO.FileExists(sFileName) = False Then 
        MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru"
        Exit Sub
    End If
    'перемещаем файл
    Set objFile = objFSO.GetFile(sFileName)
    objFile.Move sNewFileName
    MsgBox "Файл перемещен", vbInformation, "www.excel-vba.ru"
End Sub
Sub Rename_File()
    Dim objFSO As Object, objFile As Object
    Dim sFileName As String, sNewFileName As String
 
    sFileName = "C:WWW.xls"    'имя исходного файла
    sNewFileName = "WWW1.xls"    'имя файла для переименования
    'создаем объект FileSystemObject    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'проверяем наличие файла по указанному пути
    If objFSO.FileExists(sFileName) = False Then 
        MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru"
        Exit Sub
    End If
    'переименовываем файл
    Set objFile = objFSO.GetFile(sFileName)
    objFile.Name = sNewFileName
    MsgBox "Файл переименован", vbInformation, "www.excel-vba.ru"
End Sub

Хочу обратить внимание, что при переименовании файла через FileSystemObject необходимо указать только имя нового файла — путь указывать не надо. Иначе получите ошибку.

Удаление файла

Sub Delete_File()
    Dim objFSO As Object, objFile As Object
    Dim sFileName As String
 
    sFileName = "C:WWW.xls"    'имя файла для удаления
    'создаем объект FileSystemObject    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'проверяем наличие файла по указанному пути
    If objFSO.FileExists(sFileName) = False Then 
        MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru"
        Exit Sub
    End If
    'удаляем файл
    Set objFile = objFSO.GetFile(sFileName)
    objFile.Delete
    MsgBox "Файл удален", vbInformation, "www.excel-vba.ru"
End Sub

 

Точно так же можно перемещать, копировать и удалять целые папки:

Копирование папки

Sub Copy_Folder()
    Dim objFSO As Object
    Dim sFolderName As String, sNewFolderName As String
 
    sFolderName = "C:test"        'имя исходной папки
    sNewFolderName = "D:tmp"     'имя папки, в которую копируем(нужен слеш на конце)
    'создаем объект FileSystemObject    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'проверяем наличие папки по указанному пути
    If objFSO.FolderExists(sFolderName) = False Then 
        MsgBox "Нет такой папки", vbCritical, "www.excel-vba.ru"
        Exit Sub
    End If
    'копируем папку
    objFSO.CopyFolder sFolderName, sNewFolderName
 
    MsgBox "Папка скопирована", vbInformation, "www.excel-vba.ru"
End Sub
Sub Move_Folder()
    Dim objFSO As Object
    Dim sFolderName As String, sNewFolderName As String
 
    sFolderName = "C:test"           'имя исходной папки
    sNewFolderName = "C:tmptest"   'имя папки, в которую перемещаем(нужен слеш на конце)
    'создаем объект FileSystemObject    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'проверяем наличие папки по указанному пути
    If objFSO.FolderExists(sFolderName) = False Then 
        MsgBox "Нет такой папки", vbCritical, "www.excel-vba.ru"
        Exit Sub
    End If
    'перемещаем папку
    objFSO.MoveFolder sFolderName, sNewFolderName
    MsgBox "Папка перемещена", vbInformation, "www.excel-vba.ru"
End Sub
Sub Rename_Folder()
    Dim objFSO As Object, objFolder As Object
    Dim sFolderName As String, sNewFolderName As String
 
    sFolderName = "C:test"            'имя исходной папки
    'имя папки для переименования(только имя, без полного пути)
    sNewFolderName = "new folder name"
    'создаем объект FileSystemObject    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'проверяем наличие папки по указанному пути
    If objFSO.FolderExists(sFolderName) = False Then 
        MsgBox "Нет такой папки", vbCritical, "www.excel-vba.ru"
        Exit Sub
    End If
    'переименовываем папку
    'получаем доступ к объекту Folder(папка)
    Set objFolder = objFSO.GetFolder(sFolderName)
    'назначаем новое имя
    objFolder.Name = sNewFolderName
    MsgBox "Папка переименована", vbInformation, "www.excel-vba.ru"
End Sub
Sub Delete_Folder()
    Dim objFSO As Object, objFolder As Object
    Dim sFolderName As String
 
    sFolderName = "C:test"    'имя папки для удаления
    'создаем объект FileSystemObject    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'проверяем наличие папки по указанному пути
    If objFSO.FolderExists(sFolderName) = False Then 
        MsgBox "Нет такой папки", vbCritical, "www.excel-vba.ru"
        Exit Sub
    End If
    'удаляем папку
    objFSO.DeleteFolder sFolderName
    MsgBox "Папка удалена", vbInformation, "www.excel-vba.ru"
End Sub

FSO, конечно, способен на большее — но цель данной статьи была показать основные операции с папками и файлами как стандартными методами, так и более продвинутыми.


Статья помогла? Поделись ссылкой с друзьями!

  Плейлист   Видеоуроки


Поиск по меткам



Access
apple watch
Multex
Power Query и Power BI
VBA управление кодами
Бесплатные надстройки
Дата и время
Записки
ИП
Надстройки
Печать
Политика Конфиденциальности
Почта
Программы
Работа с приложениями
Разработка приложений
Росстат
Тренинги и вебинары
Финансовые
Форматирование
Функции Excel
акции MulTEx
ссылки
статистика

 

Всем доброго дня!
Может кто сталкивался — можно с помощью макроса организовать переименовку файлов в папке?
К примеру, есть файл Excel, в нем есть колонка «Название файла» и «Правильное название», где соответственно указано текущее название файла и новое, которое должно быть.
Под файлами я понимаю файлы jpg, jpeg, png. В названии файла конечно указано полное имя включая расширение.
Так вот, возможно макросом найти каждой файл (1 строка таблицы = 1 файл) и задать ему новое имя, а в случае, если файл не найден — ставить метку, что такого файла нет?

 

The_Prist

Пользователь

Сообщений: 14182
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

Пакетное переименование файлов

правда, не отмечает переименованные. еще на старом форуме(архив) поищите — когда-то выкладывал аналогичный макрос.

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

 

МатросНаЗебре

Пользователь

Сообщений: 5516
Регистрация: 05.02.2014

#3

10.02.2014 18:11:52

И ещё вариант.

Код
Sub RenameFiles()
For i = 1 To 10
    Shell "cmd.exe /c rename c:тмп" & Cells(i, 1).Text & " " & Cells(i, 2).Text
Next
End Sub
 
 

Мотя

Пользователь

Сообщений: 3218
Регистрация: 25.12.2012

Если тема еще актуальна…

 

Мотя, спасибо большое, это именно то, что нужно.
Позже посмотрю его внутри и проверю на большом массиве и отпишусь!

 

Уважаемый Мотя, а Вы не могли бы подсказать, как добавить в макрос следующее — прописать новое название в Properties файла, а именно в title.

 

Мотя

Пользователь

Сообщений: 3218
Регистрация: 25.12.2012

Уважаемая Inna Borshch!
В заявке автора не было вопроса о том, как прописать новое название в Properties файла (Title).
Поиск мне «предложил»:
ThisWorkbook.BuiltinDocumentProperties(«Title») = «Новое имя»
P.S.
1. Новое имя можно задавать явно (не явно).
2. Поскольку я — не профессионал, не могу сказать, как применить семейство свойств книги BuiltinDocumentProperties к файлам других типов.
3. Рекомендую обратиться к профессионалам.

 

Спасибо Мотя, за ответ и за наводку. Попробую разобраться.
И ещё один вопрос.
Текст файла — его основа всегда одинаковая, но ежедневно добавляется дата в названии файла (это исходник), а переименовать надо всегда по образцу.
Пример: «mama mila ramu 01.02.2014» — > «Ochenj krasivaja mama mila ramu».

Как поставить смотреть на совпадение содержания? (if contain «mama mila ramu%» then «Ochenj krasivaja mama mila ramu»).
Не подскажете?

Заранее благодарю.

 

The_Prist

Пользователь

Сообщений: 14182
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

Инна, что Вам мешает создать свою тему? Эту тему закрываю, пока Вы её в помойку своих вопросов не превратили.

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

 

The_Prist

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

И хоть Вы модератор, это не даёт Вам право хамить.

 

The_Prist

Пользователь

Сообщений: 14182
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

Тема про переименованию по списку соответствия, а не про переименование на основании текста внутри файла.

А где я Вам нахамил? Не вижу ни капли хамства в своем сообщении. Или Вас оскорбляет, что тема будет помойкой, если в неё все вопросы сваливать? Советую перечитать правила форума тогда. И на всякий случай заглянуть в википедию и прочитать значение слова «хамить».

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

 

Avercom

Пользователь

Сообщений: 2
Регистрация: 17.07.2018

День добрый!
В сообщении №4

https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=54798&am…

в файле есть макрос. Подскажите пожалуйста как отключить чувствительность к регистру.

 

Казанский

Пользователь

Сообщений: 8839
Регистрация: 11.01.2013

#13

17.07.2018 11:07:34

Avercom, первой строкой модуля (до Sub) поставьте

Код
Option Compare Text
 

Avercom

Пользователь

Сообщений: 2
Регистрация: 17.07.2018

Спасибо Вам большое!
Хороший Вы человек.
Все работает

 

utoFlowers

Пользователь

Сообщений: 1
Регистрация: 21.03.2019

#15

21.03.2019 21:45:31

Если кто-то не может скачать файл пользователя Мотя
В эксель столбец А — старое название с расширением, В — новое название с расширением
Сам макрос

Код
Sub CHANGE_NAME_FILE()
Application.ScreenUpdating = 0
Application.DisplayAlerts = 0
Dim Im_Main, Put_File, sch_VERT As Variant
Dim FS, KATALOG, FILE, MASSIV As Object
Dim II, JJ As Integer
    Range("C2:C65000").Select
    Selection.ClearContents
sch_VERT = Cells(1, 1).End(xlDown).Row - 1
Dim OLD_NAME(), NEW_NAME() As Variant
ReDim OLD_NAME(sch_VERT, 1), NEW_NAME(sch_VERT, 1)
    Range("A1:B" + Trim(Str(sch_VERT + 1))).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
OLD_NAME = Range(Cells(2, 1), Cells(2 + sch_VERT, 1))
NEW_NAME = Range(Cells(2, 2), Cells(2 + sch_VERT, 2))
Im_Main = ActiveWorkbook.Name
Put_File = Application.ActiveWorkbook.Path + ""
Set FS = CreateObject("Scripting.FileSystemObject")
Set KATALOG = FS.GetFolder(Put_File)
Set MASSIV = KATALOG.Files
If Dir(Put_File + "OUT", vbDirectory) = "" Then
    MkDir (Put_File + "OUT")
End If
If Dir(Put_File + "OUT", vbDirectory) <> "" Then
   'If Len(Dir(Put_File + "OUT*.*")) > 0 Then
      'Kill (Put_File + "OUT*.*")
   'End If
For II = 1 To sch_VERT
    For Each FILE In MASSIV
        If Dir(FILE) = OLD_NAME(II, 1) And Dir(FILE) <> Im_Main Then
           FileCopy FILE, Application.ActiveWorkbook.Path + "OUT" + NEW_NAME(II, 1)
           Cells(II + 1, 3).Value = "íàéäåí"
        End If
    Next
Next 'ii
MsgBox "ГОТОВО"
End If
Application.ScreenUpdating = 1
Application.DisplayAlerts = 1
End Sub

Спасибо!

Изменено: utoFlowers21.03.2019 21:47:53

 

john12332

Пользователь

Сообщений: 1
Регистрация: 12.05.2019

#16

12.05.2019 19:41:48

Подскажите, можно ли сделать тоже самое, только не учитывая расширения? Чтобы эксель находил имя, переименовывал на нужное и не трогал расширение.

VBA in Excel does not restrict us to just a single application. VBA gives us access to the windows environment too. With this we can perform a lot of common file-based actions. One of the most common is to rename a file. In this post, we will look at 5 examples of renaming files with VBA.

To rename a file with VBA we use the Name command. Name appears in blue because it is a reserved word within VBA.

Example 1: Renaming a file

This example renames a file from Example File.xlsx to Example File Renamed.xlsx.

Sub VBARenameFile()

Name "C:UsersmarksDocumentsExample File.xlsx" As _
    "C:UsersmarksDocumentsExample File Renamed.xlsx"

End Sub

Example 2: Rename a file based on cell values

In this example, we rename a file based on cell values. The screenshot below shows the current file name in Cell C2 and the new file name in Cell C4.

Example - VBA Rename File

We can run the following macro to rename a file using these cell values.

Sub VBARenameFileSheetNames()

Name ActiveSheet.Range("C2") As _
    ActiveSheet.Range("C4")

End Sub

Example 3: Move a file with the Name command

Did you notice the Name command requires the file path and file name? Therefore, the Name command doesn’t just rename files but can also move files. For example, the code below moves the file from C:UsersmarksDocuments to C:Usersmarks, but the file name remains the same.

Sub VBAMoveFile()

Name "C:UsersmarksDocumentsExample File.xlsx" As _
    "C:UsersmarksExample File.xlsx"

End Sub

Example 4: Avoiding errors when renaming files

Trying to move files that don’t exist, or are locked for editing can trigger errors. The errors are detailed in the section below.

If there is an error, we really want to avoid going through the Visual Basic error debugging process. Instead, a better option is to display a message box with an OK button.

Sub VBAAdvancedRenameFile()

'Create variables to hold file names
Dim filePath As String
Dim newFilePath As String

filePath = "C:UsersmarksDocumentsExample File.xlsx"
newFilePath = "C:UsersmarksDocumentsExample File Renamed.xlsx"

'Ignore errors
On Error Resume Next

'Rename file
Name filePath As newFilePath

'Display message if error occured
If Err.Number <> 0 Then
    MsgBox Prompt:="Unable to rename file", Buttons:=vbOK, _
        Title:="Rename file error"
End If

'Turn error checking back on
On Error GoTo 0

End Sub

Example 5: Reusable function

Finally, let’s create a reusable function for moving and renaming files.

The VBA function below accepts two string arguments; the existing file path and the new file path.

Function fxRenameFile(filePath As String, newFilePath As String)

'Ignore errors
On Error Resume Next

'Rename file
Name filePath As newFilePath

'Display message if error occured
If Err.Number <> 0 Then
    fxRenameFile = False
Else
    fxRenameFile = True
End If

'Turn error checking back on
On Error GoTo 0

End Function

We can use this function in two ways.

  1. Calling the function from another macro
  2. Calling the function from a worksheet

Let’s look at both of these in turn.

Calling the function from a macro

The macro below calls the function and displays a message box with the following values:

  • True = File renamed
  • False = Error occurred.
Sub CallFunction()

'Create variables to hold file names
Dim filePath As String
Dim newFilePath As String

filePath = "C:UsersmarksDocumentsExample File.xlsx"
newFilePath = "C:UsersmarksDocumentsExample File Renamed.xlsx"

'True = File Renamed
'False = Error Occured
MsgBox fxRenameFile(filePath, newFilePath)

End Sub

Calling the function from a worksheet

Alternatively, we can call the function just like a normal worksheet function.

Calling function to rename file from worksheet

Look at the screenshot above, our custom function is used in Cell C6:

=fxRenameFile(C2,C4)

TRUE indicates that the file named in Cell C2 has been successfully renamed to the file named in Cell C4. If we run the function a second time, it will show FALSE, as the file has already been renamed.

Be aware the function executes each time cells C2 or C4 change, so be careful with the order in which you update the cells.

TOP TIP: If we use the fxRenameFile function inside an IF function, it will only executes when the condition is met. In the example below, the fxRenameFile function only executes if cell A6 equals Y.

=IF(A6="Y",fxRenameFile(C2,C4),"Do not rename")

Using this method, we can control when and how the function executes. We just need to change cell A6 to another value when we don’t the function to execute.

Possible errors

If we try to rename a file or folder path that does not exist, it triggers an error: Run-time error’53’: File not found.

VBA Rename File error

If the new file name is the same as an existing one, it triggers the following error: Run-time error ’58’: File already exists.

Rename file to an existing open file

If either file name is not a valid format, it triggers the following error: Run-time error ‘5’: Invalid procedure call or argument

Invalid file name error when renaming a file with VBA

Notes on renaming files

We have used Excel workbooks in the examples, but we can use any file type. Also, we are not restricted to files; we can rename folders using the Name command too.

The Name command is core Visual Basic code. Therefore, it exists in other applications supporting VBA, such as Word and PowerPoint.

Related Posts:

  • VBA code to copy, move, delete and manage files.
  • VBA code library
  • VBA Copy File – How to + 5 examples

Headshot Round

About the author

Hey, I’m Mark, and I run Excel Off The Grid.

My parents tell me that at the age of 7 I declared I was going to become a qualified accountant. I was either psychic or had no imagination, as that is exactly what happened. However, it wasn’t until I was 35 that my journey really began.

In 2015, I started a new job, for which I was regularly working after 10pm. As a result, I rarely saw my children during the week. So, I started searching for the secrets to automating Excel. I discovered that by building a small number of simple tools, I could combine them together in different ways to automate nearly all my regular tasks. This meant I could work less hours (and I got pay raises!). Today, I teach these techniques to other professionals in our training program so they too can spend less time at work (and more time with their children and doing the things they love).


Do you need help adapting this post to your needs?

I’m guessing the examples in this post don’t exactly match your situation. We all use Excel differently, so it’s impossible to write a post that will meet everybody’s needs. By taking the time to understand the techniques and principles in this post (and elsewhere on this site), you should be able to adapt it to your needs.

But, if you’re still struggling you should:

  1. Read other blogs, or watch YouTube videos on the same topic. You will benefit much more by discovering your own solutions.
  2. Ask the ‘Excel Ninja’ in your office. It’s amazing what things other people know.
  3. Ask a question in a forum like Mr Excel, or the Microsoft Answers Community. Remember, the people on these forums are generally giving their time for free. So take care to craft your question, make sure it’s clear and concise.  List all the things you’ve tried, and provide screenshots, code segments and example workbooks.
  4. Use Excel Rescue, who are my consultancy partner. They help by providing solutions to smaller Excel problems.

What next?
Don’t go yet, there is plenty more to learn on Excel Off The Grid.  Check out the latest posts:

I want to replace anything before an underscore and prefix underscore with an increasing integer i in excel vba to rename all the files in a folder.

braX's user avatar

braX

11.5k5 gold badges20 silver badges33 bronze badges

asked Dec 28, 2017 at 10:51

Anurag's user avatar

1

Sub RenameFiles()
Const FolderLoc = "P:yourfolder"
Dim x As Long
x = 1
Dim s As String
s = Dir(FolderLoc & "*.*")
Do While s <> ""
    Name FolderLoc & s As FolderLoc & x & Right(s, Len(s) - (InStr(s, "_") - 1))
    s = Dir()
    x = x + 1
Loop
End Sub

answered Dec 28, 2017 at 11:17

Harassed Dad's user avatar

Harassed DadHarassed Dad

4,6491 gold badge10 silver badges12 bronze badges

1

‘MACRO to Rename backed up files and place in order
Sub Rename2()

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object, abc As Object
Dim i As String
Dim s As String, dest As String

dest = "H:Automationoutputs"

Set objFSO = CreateObject("Scripting.FileSystemObject")
FolderLoc = dest


Set objFolder = objFSO.GetFolder(dest)
'MsgBox objFolder

i = 1
s = Dir(FolderLoc & "*.*")

On Error Resume Next

'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files

    Do While (InStr(s, "_")) > 0
        'MsgBox s
        'Name OldFile as NewFile

        Name FolderLoc & s As FolderLoc & i & "." & Right(s, Len(s) - (InStr(s, "_") + 2))
        s = i & "." & Right(s, Len(s) - (InStr(s, "_") + 2))
        'MsgBox s
        'abc = Name FolderLoc & s As FolderLoc & "(" & i & ")" & Right(s, Len(s) - (InStr(s, "@_@") + 2))
        'i = i + 1
    Loop
    i = i + 1
    s = Dir()

Next objFile

End Sub

Our Man in Bananas's user avatar

answered Jan 5, 2018 at 10:44

Anurag's user avatar

AnuragAnurag

192 silver badges4 bronze badges

0 / 0 / 0

Регистрация: 10.03.2019

Сообщений: 111

1

Переименовать файлы в разных папках

07.07.2019, 17:43. Показов 6302. Ответов 24


Студворк — интернет-сервис помощи студентам

Всем добрый вечер. Нужно переименовать файлы находящиеся в разных папках
имя Путь
a12.docx D:переименовать файлы1а12
f12.docx D:переименовать файлы12
и11.docx D:переименовать файлы11s

в любые другие имена например:
имя Путь
11a12.docx D:переименовать файлы1а12
23f12.docx D:переименовать файлы12
44и11.docx D:переименовать файлы11s

Не подскажите макрос в VBA для excel?



0



Strashnoslav

0 / 0 / 0

Регистрация: 10.03.2019

Сообщений: 111

07.07.2019, 20:31

 [ТС]

3

Искал но удобного для работы не нашел.
Вот например из ссылки

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Sub Rename_File()
    Dim sFileName As String, sNewFileName As String
 
    sFileName = "C:WWW.xls"    'имя исходного файла
    sNewFileName = "C:WWW1.xls"    'имя файла для переименования
    If Dir(sFileName, 16) = "" Then MsgBox "Нет такого файла", vbCritical, "Ошибка": Exit Sub
 
    Name sFileName As sNewFileName 'переименовываем файл
 
    MsgBox "Файл переименован", vbInformation, "www.excel-vba.ru"
End Sub

Как можно здесь переименовать, имея список с именами и адресами и новый в который необходимо переименовать?



0



Burk

1813 / 1135 / 346

Регистрация: 11.07.2014

Сообщений: 4,002

08.07.2019, 06:54

4

Strashnoslav, составить массив исходных имен, либо записать их , например, в первый столбец листа, во второй соответствующие новые имена. а потом цикл по этим ячейкам. На основе того, что вы прочитали это можно записать так

Visual Basic
1
2
3
4
5
6
Last = cells(Rows.Count,1).End(xlUp).Row
For I = 1 to Last
  sFileName = Cells(I,1)
  sNewFileName = Cells(I,2)
  Name sFileName As sNewFileName 'переименовываем файл
Next



0



Strashnoslav

0 / 0 / 0

Регистрация: 10.03.2019

Сообщений: 111

22.02.2020, 15:26

 [ТС]

5

Доброго времени суток. Не подскажите как с помощью подобного макроса

Visual Basic
1
2
3
4
5
6
7
8
Sub tt()
Last = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To Last
  sFileName = Cells(i, 1)
  sNewFileName = Cells(i, 2)
    FileCopy sFileName, sNewFileName 
    Next
End Sub

скопировать исходные имена файлов с со своими каталогами, в другой каталог при этом создать исходные каталоги где находились файлы.

Вложения

Тип файла: xlsx пример.xlsx (10.2 Кб, 4 просмотров)



0



6875 / 2807 / 533

Регистрация: 19.10.2012

Сообщений: 8,562

22.02.2020, 16:29

6

Добавьте перед копированием строку
MakeSureDirectoryPathExists sNewFileName
(может быть будет мешать имя файла, тогда его нужно отрезать, я не проверял и не помню)
а в модуль
Private Declare Function MakeSureDirectoryPathExists Lib «imagehlp.dll» (ByVal lpPath As String) As Long



0



Burk

1813 / 1135 / 346

Регистрация: 11.07.2014

Сообщений: 4,002

22.02.2020, 17:19

7

Strashnoslav, например так

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub proba()
[A1] = "d:Evgenychance.xlsm" 'на примере папок моего компа
Last = Cells(Rows.Count, 1).End(xlUp).Row
For I = 1 To Last
  Call CopyFile(Cells(I, 1), "d:TMP")
Next
End Sub
 
Sub CopyFile(ByVal Source As String, ByVal NewDir As String)
Dim Sold As String, Snew As String, I As Integer, Last As Integer, Nd As String
Snew = NewDir & "" & Mid(Source, 4)
Nd = Left(Snew, InStrRev(Snew, ""))
If Dir(Nd, vbDirectory) = "" Then MkDir Nd
'MsgBox Source & "  " & Snew
FileCopy Source, Destination:=Snew
End Sub



0



6875 / 2807 / 533

Регистрация: 19.10.2012

Сообщений: 8,562

22.02.2020, 17:47

8

MkDir насколько помню создаёт не дерево, а только один каталог. MakeSureDirectoryPathExists создаёт сразу дерево. Кстати если вдруг в именах нужна диакритика — тоже есть решение, используйте SHCreateDirectoryExW



0



Burk

1813 / 1135 / 346

Регистрация: 11.07.2014

Сообщений: 4,002

22.02.2020, 20:14

9

А можно ещё почесать левое ухо правой рукой через голову (Hugo121, конечно, прав)

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
Sub CopyFile(ByVal Source As String, ByVal NewDir As String)
Dim Snew As String, Last As Integer, K, Nd As String
K = 4: Snew = NewDir & Mid(Source, InStrRev(Source, "") + 1)
Do
  K = InStr(K + 1, Snew, "")
  If K = 0 Then Exit Do
  Nd = Left(Snew, K)
'  MsgBox "k=" & K & "  " & Nd
  If Dir(Nd, vbDirectory) = "" Then MkDir Nd
Loop
FileCopy Source, Destination:=Snew
End Sub



0



Strashnoslav

0 / 0 / 0

Регистрация: 10.03.2019

Сообщений: 111

22.02.2020, 22:11

 [ТС]

10

Hugo121, не выходит, пробовал

Visual Basic
1
2
3
4
5
6
7
8
9
Sub tt()
Last = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To Last
  sFileName = Cells(i, 1)
  sNewFileName = Cells(i, 2)
  MakeSureDirectoryPathExists sNewFileName
    FileCopy sFileName, sNewFileName 'копируем файл
Next
End Sub

Затем обрезал тоже не выходит, может что не так делаю

Вложения

Тип файла: rar пример.rar (12.0 Кб, 9 просмотров)



0



Strashnoslav

0 / 0 / 0

Регистрация: 10.03.2019

Сообщений: 111

22.02.2020, 22:26

 [ТС]

11

Burk, что-то не разберусь с вашем макросом

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
Sub CopyFile(ByVal Source As String, ByVal NewDir As String)
Dim Snew As String, Last As Integer, K, Nd As String
K = 4: Snew = NewDir & Mid(Source, InStrRev(Source, "") + 1)
Do
  K = InStr(K + 1, Snew, "")
  If K = 0 Then Exit Do
  Nd = Left(Snew, K)
'  MsgBox "k=" & K & "  " & Nd
  If Dir(Nd, vbDirectory) = "" Then MkDir Nd
Loop
FileCopy Source, Destination:=Snew
End Sub

Добавлено через 6 минут
По идее мне нужен макрос который создаст дерево каталогов, а затем уже не трудно туда закинуть файлы



0



6875 / 2807 / 533

Регистрация: 19.10.2012

Сообщений: 8,562

22.02.2020, 22:30

12

Цитата
Сообщение от Hugo121
Посмотреть сообщение

а в модуль
Private Declare Function MakeSureDirectoryPathExists Lib «imagehlp.dll» (ByVal lpPath As String) As Long

— почему остановились на третьей строке? Или второй? Или четвёртой?

Добавлено через 1 минуту
Да, это для Экселя х32

Добавлено через 1 минуту
Проверил — имя файла не мешает.



0



1813 / 1135 / 346

Регистрация: 11.07.2014

Сообщений: 4,002

23.02.2020, 01:08

13

Strashnoslav, это не макрос, а процедура с параметрами или вы их не различаете? Пример макроса запуска мой макрос proba. Просто ту процедуру CopyFile из первого моего сообщения надо заменить на CopyFile их второго сообщения.
Создаются деревья каталогов, если их нет, и тут же копируются туда файлы, получаемые с листа экселя. Надо их занести в столбик подряд на лист. Но я думаю, что у Hugo121 проще. И не надо копировать мои макросы в своё сообщение, тем более, что вы неправильно их оформляете. надо выделить код и нажать на VB в меню, читайте правила

Добавлено через 12 минут
пример ссылки на файл, который нужно копировать. Записать в ячейку А1 такую, например, строку d:Papka1Papka2имя файла с расширением. В ячейку листа А2 и т.д. аналогично. Вы ведь так и хотели.



0



0 / 0 / 0

Регистрация: 10.03.2019

Сообщений: 111

23.02.2020, 09:39

 [ТС]

14

Hugo121, а можете скинуть рабочий вариант, буду очень благодарен



0



6875 / 2807 / 533

Регистрация: 19.10.2012

Сообщений: 8,562

23.02.2020, 14:39

15

Лучший ответ Сообщение было отмечено Strashnoslav как решение

Решение

Да в тот же добавить просто в модуль (тот или другой, не важно) первой строкой эту указанную строку и всё работает.

Добавлено через 11 минут
В тот что в пример.rar



1



0 / 0 / 0

Регистрация: 10.03.2019

Сообщений: 111

23.02.2020, 19:11

 [ТС]

16

Спасибо. Модуль добавлял, но почему-то не выполнялось, сейчас заново все вставил и заработало. Всех мужчин с праздником!!!!



0



Strashnoslav

0 / 0 / 0

Регистрация: 10.03.2019

Сообщений: 111

04.03.2020, 23:01

 [ТС]

17

Всем доброго времени суток. Не подскажите как игнорировать повторяющиеся строки имен при переименовании

Visual Basic
1
2
3
4
5
6
7
8
Sub tt()
Last = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To Last
  sFileName = Cells(i, 1)
  sNewFileName = Cells(i, 2)
  Name sFileName As sNewFileName 
Next
End Sub

Добавлено через 19 минут
Например
e:1231111.docx e:12311111.docx
e:1231111.docx e:12311112.docx
пропускал повторяющуюся строчку исходного имени, даже если новое имя другое



0



6875 / 2807 / 533

Регистрация: 19.10.2012

Сообщений: 8,562

05.03.2020, 01:46

18

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



0



Strashnoslav

0 / 0 / 0

Регистрация: 10.03.2019

Сообщений: 111

06.04.2021, 15:54

 [ТС]

19

Доброго времени суток. Не подскажите, как сделать чтобы при несовпадении полного исходного имени, переходил к следующей строке:

Visual Basic
1
2
3
4
5
6
7
8
9
10
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
Sub tt()
Last = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To Last
  sFileName = Cells(i, 1)
  sNewFileName = Cells(i, 2)
  MakeSureDirectoryPathExists sNewFileName
    FileCopy sFileName, sNewFileName 'копируем файл
Next
End Sub



0



6875 / 2807 / 533

Регистрация: 19.10.2012

Сообщений: 8,562

10.04.2021, 22:00

20

Цитата
Сообщение от Strashnoslav
Посмотреть сообщение

при несовпадении полного исходного имени

— с чем?



0



Понравилась статья? Поделить с друзьями:
  • Макрос для матрицы в excel
  • Макрос для копирования ячеек excel
  • Макрос для копирования файла excel
  • Макрос для копирования только значений в excel
  • Макрос для копирования текста word