Как средствами VBA переименовать/переместить/скопировать файл
В этой статье я хотел бы рассказать как средствами VBA переименовать, переместить или скопировать файл. В принципе методы переименования, перемещения и копирования, так сказать, встроены в VBA. Это значит что можно без вызова сторонних объектов переименовать, переместить или копировать любой файл. Все это делается при помощи всего двух команд: FileCopy и Name [Исходный файл] As [Новый файл]. Притом команда FileCopy выполняет только копирование, а Name [Исходный файл] As [Новый файл] - как переименование, так и перемещение. Разница лишь в том, что при переименовании мы указываем только новое имя файла, а при перемещении - другую директорию(папку), в которую следует переместить файл. Плюс рассмотрим пример удаления файла.
Так же разберем методы копирования, перемещения, переименования и удаления файлов и папок через библиотеку FileSystemObject (FSO).
Во всех примерах работы с файлами встроенными функциями будет присутствовать проверка на наличие файла по указанному пути. Делать это будем при помощи встроенной функции Dir([PathName],[Attributes]). PathName - указывается полный путь к файлу Attributes - указывается признак свойств файла. Вообще их несколько(скрытый, архивный и т.п.), но нас для наших задач будет интересовать пока только один: 16(vbDirectory). Он отвечает за проверку папок и файлов без специальных свойств(т.е. не архивные, не скрытые и т.д.). Хотя по сути его можно вообще не указывать, и тогда будет по умолчанию применен атрибут 0(vbNormal) - проверка файлов без определенных свойств. Ни в том ни в другом случае ошибкой это не будет.
Копирование файла
Sub Copy_File()
Dim sFileName AsString, sNewFileName AsString
sFileName = "C:\WWW.xls"'имя файла для копирования
sNewFileName = "D:\WWW.xls"'имя копируемого файла. Директория(в данном случае диск D) должна существоватьIf Dir(sFileName, 16) = ""Then
MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru"ExitSubEndIf
FileCopy sFileName, sNewFileName 'копируем файл
MsgBox "Файл скопирован", vbInformation, "www.excel-vba.ru"EndSub
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
У этого метода копирования есть существенный недостаток: если файл уже открыт в другой программе(например, книга Excel на данный момент открыта) - данный метод выдаст ошибку доступа "70 Permission denied". Избежать этого можно либо закрытием файла, либо копированием с использованием библиотеки FSO(работу с ним рассмотрим далее в этой статье).
Перемещение файла
Sub Move_File()
Dim sFileName AsString, sNewFileName AsString
sFileName = "C:\WWW.xls"'имя исходного файла
sNewFileName = "D:\WWW.xls"'имя файла для перемещения. Директория(в данном случае диск D) должна существоватьIf Dir(sFileName, 16) = ""Then
MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru"ExitSubEndIf
Name sFileName As sNewFileName 'перемещаем файл
MsgBox "Файл перемещен", vbInformation, "www.excel-vba.ru"EndSub
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 AsString, sNewFileName AsString
sFileName = "C:\WWW.xls"'имя исходного файла
sNewFileName = "C:\WWW1.xls"'имя файла для переименованияIf Dir(sFileName, 16) = ""Then
MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru"ExitSubEndIf
Name sFileName As sNewFileName 'переименовываем файл
MsgBox "Файл переименован", vbInformation, "www.excel-vba.ru"EndSub
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 AsString
sFileName = "C:\WWW.xls"'имя файла для удаленияIf Dir(sFileName, 16) = ""Then
MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru"ExitSubEndIf
Kill sFileName 'удаляем файл
MsgBox "Файл удален", vbInformation, "www.excel-vba.ru"EndSub
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
Как видно ничего сложного.
Что такое FSO
Так же можно проделать те же операции с файлами при помощи объекта FileSystemObject. Строк кода несколько больше и выполняться операции будут медленнее(хотя вряд ли это будет заметно на примере одного файла). Однако есть существенный плюс - при помощи FileSystemObject можно корректно производить операции с файлами и папками на сетевом диске. Хотя та же Dir(sFileName, 16) часто выдает ошибку при работе с сетевыми дисками.
Так же при копировании открытого(в Excel или другой программе) файла встроенными средствами VBA, может возникать ошибка доступа к файлу, а при копировании при помощи FSO - этой ошибки нет.
Прежде всего немного разберемся с тем, что за зверь такой - FileSystemObject. FileSystemObject (FSO) - содержится в библиотеке типов Scripting, расположенной в файле библиотеки scrrun.dll. Это стандартная библиотека Windows, а следовательно работать будет на всех ПК под управлением этой операционной системы. Объектная модель FSO дает возможность создавать, изменять, перемещать и удалять папки и файлы, собирать о них различную информацию: имена, атрибуты, даты создания или изменения и т.д. Чтобы работать с FSO необходимо создать переменную со ссылкой на объект библиотеки. Сделать это можно двумя способами: через раннее связывание и позднее. Я не буду сейчас вдаваться в подробности этих методов - тема довольно обширная и я опишу её в другой статье. Ранее связывание: для начала необходимо подключить библиотеку Microsoft Scripting Runtime. Делается это в редакторе VBA: References-находите там Microsoft Scripting Runtime и подключаете(ставите напротив неё галочку). Объявлять переменную FSO при раннем связывании следует так:
Dim objFSO AsNew FileSystemObject
Dim objFSO As New FileSystemObject
Плюсы раннего связывания: с помощью Object Browser можно просмотреть список объектов, свойств, методов, событий и констант, включенных в FSO. Но есть значительный минус: если планируется использовать программу на нескольких компьютерах, то есть большая вероятность получить ошибку (читать подробнее). Позднее связывание: ничего нигде не надо подключать, а просто используем метод CreateObject (именно этот способ используется мной в примерах ниже). Методы таким образом просмотреть не получится, но зато работать будет без проблем на любых компьютерах без дополнительных действий.
Копирование файла
Sub Copy_File()
Dim objFSO AsObject, objFile AsObjectDim sFileName AsString, sNewFileName AsString
sFileName = "C:\WWW.xls"'имя исходного файла
sNewFileName = "D:\WWW.xls"'имя файла для переименования'создаем объект FileSystemObjectSet objFSO = CreateObject("Scripting.FileSystemObject")
'проверяем наличие файла по указанному путиIf objFSO.FileExists(sFileName) = FalseThen
MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru"ExitSubEndIf'копируем файлSet objFile = objFSO.GetFile(sFileName)
objFile.Copy sNewFileName
MsgBox "Файл скопирован", vbInformation, "www.excel-vba.ru"EndSub
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 AsObject, objFile AsObjectDim sFileName AsString, sNewFileName AsString
sFileName = "C:\WWW.xls"'имя исходного файла
sNewFileName = "D:\WWW.xls"'имя файла для переименования'создаем объект FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject")
'проверяем наличие файла по указанному путиIf objFSO.FileExists(sFileName) = FalseThen
MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru"ExitSubEndIf'перемещаем файлSet objFile = objFSO.GetFile(sFileName)
objFile.Move sNewFileName
MsgBox "Файл перемещен", vbInformation, "www.excel-vba.ru"EndSub
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 AsObject, objFile AsObjectDim sFileName AsString, sNewFileName AsString
sFileName = "C:\WWW.xls"'имя исходного файла
sNewFileName = "WWW1.xls"'имя файла для переименования'создаем объект FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject")
'проверяем наличие файла по указанному путиIf objFSO.FileExists(sFileName) = FalseThen
MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru"ExitSubEndIf'переименовываем файлSet objFile = objFSO.GetFile(sFileName)
objFile.Name = sNewFileName
MsgBox "Файл переименован", vbInformation, "www.excel-vba.ru"EndSub
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 AsObject, objFile AsObjectDim sFileName AsString
sFileName = "C:\WWW.xls"'имя файла для удаления'создаем объект FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject")
'проверяем наличие файла по указанному путиIf objFSO.FileExists(sFileName) = FalseThen
MsgBox "Нет такого файла", vbCritical, "www.excel-vba.ru"ExitSubEndIf'удаляем файлSet objFile = objFSO.GetFile(sFileName)
objFile.Delete
MsgBox "Файл удален", vbInformation, "www.excel-vba.ru"EndSub
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 AsObjectDim sFolderName AsString, sNewFolderName AsString
sFolderName = "C:\test"'имя исходной папки
sNewFolderName = "D:\tmp\"'имя папки, в которую копируем(нужен слеш на конце)'создаем объект FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject")
'проверяем наличие папки по указанному путиIf objFSO.FolderExists(sFolderName) = FalseThen
MsgBox "Нет такой папки", vbCritical, "www.excel-vba.ru"ExitSubEndIf'копируем папку
objFSO.CopyFolder sFolderName, sNewFolderName
MsgBox "Папка скопирована", vbInformation, "www.excel-vba.ru"EndSub
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 AsObjectDim sFolderName AsString, sNewFolderName AsString
sFolderName = "C:\test"'имя исходной папки
sNewFolderName = "C:\tmp\test\"'имя папки, в которую перемещаем(нужен слеш на конце)'создаем объект FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject")
'проверяем наличие папки по указанному путиIf objFSO.FolderExists(sFolderName) = FalseThen
MsgBox "Нет такой папки", vbCritical, "www.excel-vba.ru"ExitSubEndIf'перемещаем папку
objFSO.MoveFolder sFolderName, sNewFolderName
MsgBox "Папка перемещена", vbInformation, "www.excel-vba.ru"EndSub
Sub Move_Folder()
Dim objFSO As Object
Dim sFolderName As String, sNewFolderName As String
sFolderName = "C:\test" 'имя исходной папки
sNewFolderName = "C:\tmp\test\" 'имя папки, в которую перемещаем(нужен слеш на конце)
'создаем объект 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 AsObject, objFolder AsObjectDim sFolderName AsString, sNewFolderName AsString
sFolderName = "C:\test\"'имя исходной папки'имя папки для переименования(только имя, без полного пути)
sNewFolderName = "new folder name"'создаем объект FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject")
'проверяем наличие папки по указанному путиIf objFSO.FolderExists(sFolderName) = FalseThen
MsgBox "Нет такой папки", vbCritical, "www.excel-vba.ru"ExitSubEndIf'переименовываем папку'получаем доступ к объекту Folder(папка)Set objFolder = objFSO.GetFolder(sFolderName)
'назначаем новое имя
objFolder.Name = sNewFolderName
MsgBox "Папка переименована", vbInformation, "www.excel-vba.ru"EndSub
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 AsObject, objFolder AsObjectDim sFolderName AsString
sFolderName = "C:\test\"'имя папки для удаления'создаем объект FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject")
'проверяем наличие папки по указанному путиIf objFSO.FolderExists(sFolderName) = FalseThen
MsgBox "Нет такой папки", vbCritical, "www.excel-vba.ru"ExitSubEndIf'удаляем папку
objFSO.DeleteFolder sFolderName
MsgBox "Папка удалена", vbInformation, "www.excel-vba.ru"EndSub
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, конечно, способен на большее - но цель данной статьи была показать основные операции с папками и файлами как стандартными методами, так и более продвинутыми.
Дмитрий, большое спасибо за статью!
Насколько я понимаю, данные коды работают только с одним файлом?
А нельзя переделать код так, чтобы он искал файлы (несколько) в определенной директории по названию(вернее не по полному имени файла а по слову(словам) встречающемуся в названии и затем уже все названные файлы помещал в указанную папку.
Несколько запутанно изложил мысль...
Попробую по другому.
Сейчас для копирования я пользуюсь стандартным поисковиком оффиса, который ищет файлы на общесетевом диске, затем я эти файлы копирую в определенную папку и дальше с ними работаю. Можно ли это сделать средствами VBA?
Здравствуйте, Дмитрий! У меня подсвечивается строка FileCopy sFileName, sNewFileName
Может ли это быть связано с тем, что я копирую в папку user, на которой нарисован замок?
Вот мой путь:
sNewFileName = "С:\Пользователи\user\OneDrive\День_1.1.xlsm"
Здравствуйте, Дмитрий! Подскажите пожалуйста если при копировании файла я меняю путь и имя файла на
sFileName = Range("a1")
sNewFileName = Range("b1")
Возможно ли это применить ко всем строкам (заполненным в таблице) Заранее спасибо.
Правильно писать
sFileName = Range("a1").value
sNewFileName = Range("b1").value
но лучше
r=1
do
sFileName = cells(r,1).value
sNewFileName = cells(r,2).value
if sFileName="" then
exit do
endif
FileCopy sFileName, sNewFileName
r=r+1
loop
Добавьте проверку наличия файла
и получите копирование всех файлов с именами из колонки А
в файлы с именами из колонки В.
Копирование остановится, когда встретится первая пустая ячейка в колонке А.
Добрый день. Подскажите, пожалуйста, что в Dir(sFileName, 16) означает число 16?
16 означает константу vbDirectory. Чтобы лучше понять советую почитать справку VBA по методу Dir, там все написано подробно.
Спасибо. Почитаю
Дмитрий, большое спасибо за статью!
Насколько я понимаю, данные коды работают только с одним файлом?
А нельзя переделать код так, чтобы он искал файлы (несколько) в определенной директории по названию(вернее не по полному имени файла а по слову(словам) встречающемуся в названии и затем уже все названные файлы помещал в указанную папку.
Несколько запутанно изложил мысль...
Попробую по другому.
Сейчас для копирования я пользуюсь стандартным поисковиком оффиса, который ищет файлы на общесетевом диске, затем я эти файлы копирую в определенную папку и дальше с ними работаю. Можно ли это сделать средствами VBA?
Игорь, прочитайте статью:Просмотреть все файлы в папке
Если грамотно объединить ту и эту статьи - получите желаемое.
Спасибо, Дмитрий! Я видно пропустил данную статью. Попробую объединить оба метода.
Еще раз спасибо!
Здравствуйте, Дмитрий! У меня подсвечивается строка FileCopy sFileName, sNewFileName
Может ли это быть связано с тем, что я копирую в папку user, на которой нарисован замок?
Вот мой путь:
sNewFileName = "С:\Пользователи\user\OneDrive\День_1.1.xlsm"
Здравствуйте, Дмитрий! Подскажите пожалуйста если при копировании файла я меняю путь и имя файла на
sFileName = Range("a1")
sNewFileName = Range("b1")
Возможно ли это применить ко всем строкам (заполненным в таблице) Заранее спасибо.
Правильно писать
sFileName = Range("a1").value
sNewFileName = Range("b1").value
но лучше
r=1
do
sFileName = cells(r,1).value
sNewFileName = cells(r,2).value
if sFileName="" then
exit do
endif
FileCopy sFileName, sNewFileName
r=r+1
loop
Добавьте проверку наличия файла
и получите копирование всех файлов с именами из колонки А
в файлы с именами из колонки В.
Копирование остановится, когда встретится первая пустая ячейка в колонке А.