Как средствами VBA переименовать/переместить/скопировать файл

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

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

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, "Ошибка": Exit Sub 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, "Ошибка": Exit Sub 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, "Ошибка": Exit Sub 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, "Ошибка": Exit Sub Kill sFileName 'удаляем файл MsgBox "Файл удален", vbInformation, "www.excel-vba.ru" End Sub

Вот так. Вроде ничего сложного.

Так же я хотел бы описать как можно проделать те же операции с файлами при помощи объекта FileSystemObject. Строк кода несколько больше и выполняться операции будут медленнее(хотя вряд ли это будет заметно на примере одного файла). Но раз начал разбирать эту тему - решил показать и эти методы. Прежде всего следует, я думаю, пояснить что за зверь такой - 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" 'имя файла для переименования If Dir(sFileName, 16) = "" Then MsgBox "Нет такого файла", vbCritical, "Ошибка": Exit Sub 'копируем файл Set objFSO = CreateObject("Scripting.FileSystemObject") 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" 'имя файла для переименования If Dir(sFileName, 16) = "" Then MsgBox "Нет такого файла", vbCritical, "Ошибка": Exit Sub 'перемещаем файл Set objFSO = CreateObject("Scripting.FileSystemObject") 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" 'имя файла для переименования If Dir(sFileName, 16) = "" Then MsgBox "Нет такого файла", vbCritical, "Ошибка": Exit Sub 'переименовываем файл Set objFSO = CreateObject("Scripting.FileSystemObject") 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" 'имя файла для удаления If Dir(sFileName, 16) = "" Then MsgBox "Нет такого файла", vbCritical, "Ошибка": Exit Sub 'удаляем файл Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFile = objFSO.GetFile(sFileName) objFile.Delete MsgBox "Файл удален", vbInformation, "www.excel-vba.ru" End Sub

Вот теперь вроде бы все.