Excel миф как скопировать файл

Хитрости »

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

В этой статье я хотел бы рассказать как средствами 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

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
ссылки
статистика

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

Sub Название_Макроса()

'Выделить диапазон который необходимо скопировать
Range("A1:F52").Select
'Скопировать то, что выделено
Selection.Copy
ChDir "путь к папке где лежит файл в который необходимо скопировать"
Workbooks.Open Filename:= "Название файла, который находится в папке, путь к которой указан выше"
'Выделить начальную ячейку в которую необходимо вставить скопированные данные
Range("A6").Select
'Вставить данные
ActiveSheet.Paste
'сохранить текущую книгу
ActiveWorkbook.Save
'Закрыть книгу
ActiveWorkbook.Close
End Sub

Вариант 2: В открывшейся книге запускаем макрос, чтобы он открыл нужную нам книгу, скопировал от туда нужные нам данные и вставил в нашу открытую книгу, закрыв файл из которого эти данные были скопированы

Sub Название_Макроса2()
'Открываем файл с которого нужно скопировать данные
Workbooks.Open Filename:="C:Данные.xlsx"

'Скопировать нужный диапазон в открывшейся книге на листе 1
Workbooks("Данные.xlsx").Worksheets("Лист1").Range("A16:E16").Copy
'Активируем нужную нам книгу
Workbooks("Книга1.xlsm").Activate

'Выделяем и вставляем скопированные данные в ячейку А1
ActiveWorkbook.Worksheets("Лист1").Range("A1").Select
ActiveSheet.Paste

'Закрываем книгу откуда мы скопировали данные
Workbooks("Данные.xlsx").Close

End Sub

Еще пример — Скопировать диапазоны данных из активной открытой книги Excel нескольких листов (в нашем примере 3-х листов) в другую книгу, которая хранится в определенном месте. Данные будут вставлены как значения, плюс будут перенесены форматы ячеек.

Sub Копируем_листы_в_другую_книгу()
Dim bookconst As Workbook
Dim abook As Workbook
Set abook = ActiveWorkbook 'присваиваем перменную активной книге
Set bookconst = Workbooks.Open("C:UsersUserDesktop1.xlsx") 'присваиваем перменную книге куда необходимо копировать данные

'переходим в активную книгу откуда необходимо скопировать данные
abook.Worksheets("Лист1").Activate
Range("A1:I23").Copy 'копируем определенный диапазон листа, укажите свой диапазон
bookconst.Worksheets("Лист1").Activate 'активируем лист куда необходимо вставить данные
Range("A1:I23").Select 'встаем на ячейку А1
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'вставляем только форматы ячеек
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'второй лист
abook.Worksheets("Лист2").Activate
Range("A1:I23").Copy
bookconst.Worksheets("Лист2").Activate
Range("A1:I23").Select 'выделяем диапазон
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'вставляем только форматы ячеек
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'третий лист
abook.Worksheets("Лист3").Activate
Range("A1:I23").Copy
bookconst.Worksheets("Лист3").Activate
Range("A1:I23").Select 'выделяем диапазон
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'вставляем только форматы ячеек
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'сохранить текущую книгу
bookconst.Save
'Закрыть книгу
bookconst.Close
abook.Activate

End Sub

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

Спасибо за внимание.