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

Хитрости »

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

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

You can easily copy sheets in Excel manually with a few simple mouse clicks. On the other hand, you need a macro if you want to automate this process. In this guide, we’re going to show you how to copy sheets in Excel with VBA.

Download Workbook

Before you start

If you are new to VBA and macro concept, VBA is a programming language for Office products. Microsoft allows users to automate tasks or modify properties of Office software. A macro, on the other hand, is a set of VBA code which you tell the machine what needs to be done.

Macros, or codes, should be written in modules, which are text areas in VBA’s dedicated user interface. Also, the file should be saved as Excel Macro Enabled Workbook in XLSM format to keep the codes.

You can find detailed instructions in our How to create a macro in Excel guide.

New Workbook

Copy active sheet to a new workbook

The first code is the simplest and shortest one which performs the action the title suggests:

Public Sub CopyActiveSheetToNewWorkbook()

  ActiveSheet.Copy

End Sub

As you can figure out ActiveSheet selector indicates the active sheet in the user window. Once the code run successfully, you will see the copy in a new workbook.

Copy a specific sheet to a new workbook

The following code copies “SUMIFS” sheet into a new workbook, regardless of sheet’s active status.

Public Sub CopySpecificSheetToNewWorkbook()

  Sheets("SUMIFS").Copy

End Sub

Copy selected sheets to a new workbook

If you need to copy selected sheets into a new workbook, use ActiveWindow.SelectedSheets selector.

Public Sub CopyActiveSheetsToNewWorkbook()

  ActiveWindow.SelectedSheets.Copy

End Sub

Copy active sheet to a specific position in the same workbook

If you specify a position in the code, VBA duplicates the sheet in a specific position of in the workbook. To do this placement, you can use Before and After arguments with Copy command. With these arguments, you can place the new sheet before or after an existing worksheet.

You can use either sheet names or their indexes to indicate the existing sheet. Here are a few samples:

Public Sub CopyActiveSheetAfterSheet_Name()

  'Copies the active sheet after "Types" sheet

  ActiveSheet.Copy After:=Sheets("Types")

End Sub

    

Public Sub CopyActiveSheetAfterSheet_Index()

  'Copies after 2nd sheet

  ActiveSheet.Copy After:=Sheets(2)

End Sub

    

Public Sub CopyActiveSheetAfterLastSheet()

  'Copies the active sheet after the last sheet

  'Sheets.Count command returns the number of the sheets in the workbook

  ActiveSheet.Copy After:=Sheets(Sheets.Count)

End Sub

    

Public Sub CopyActiveSheetBeforeSheet_Name()

  'Copies the active sheet before "Types" sheet

  ActiveSheet.Copy Before:=Sheets("Types")

End Sub

    

Public Sub CopyActiveSheetBeforeSheet_Index()

  'Copies the active sheet before 2nd sheet

  ActiveSheet.Copy Before:=Sheets(2)

End Sub

    

Public Sub CopyActiveSheetBeforeFirstSheet()

  'Copies the active sheet before the first sheet

  ActiveSheet.Copy Before:=Sheets(1)

End Sub

Copy active sheet to an existing workbook

To copy anything to an existing workbook, there are 2 perquisites:

1. Target workbook should be open as well
2. You need to specify the target workbooks by name

Sub CopySpecificSheetToExistingWorkbook()

  ' define a workbook variable and assign target workbook

  ' thus, we can use variable multiple times instead of workbook reference

  Dim targetSheet As Workbook

  Set targetSheet = Workbooks("Target Workbook.xlsx")

  'copies "Names" sheet to the last position in the target workbook

  Sheets("Names").Copy After:=targetSheet.Sheets(targetSheet.Worksheets.Count)

End Sub