MyTetra Share
Делитесь знаниями!
Как средствами VBA переименовать/переместить/скопировать файл
16.03.2019
23:43
Текстовые метки: fso
Раздел: !Закладки - VBA - GetOpen

Как средствами 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


1

2

3

4

5

6

7

8

9

10

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


1

2

3

4

5

6

7

8

9

10

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


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

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

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


1

2

3

4

5

6

7

8

9

10

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


1

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


1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

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


1

2

3

4

5

6

7

8

9

10

11

12

13

14

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


1

2

3

4

5

6

7

8

9

10

11

12

13

14

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


1

2

3

4

5

6

7

8

9

10

11

12

13

14

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

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

Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования