Забыли пароль?


Хитрости »
Основные понятия (24)
Сводные таблицы и анализ данных (10)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (17)
Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (65)
Разное (42)
Баги и глюки Excel (4)

Как получить данные из закрытой книги?

Достаточно часто появляется вопрос: как извлечь данные из закрытой книги Excel через VBA? Звучит может быть странновато, но это так: вопрос регулярно поднимается на форумах. Собственно, именно в связи с этим и появилась на свет данная статья. В принципе ничего сложного в задаче нет. При этом получить данные можно разными способами, в том числе при помощи функций пользователя(UDF).
Попробуем разобраться с некоторыми методами, их плюсами и минусами.

Получение данных из закрытой книги из процедуры

Sub Get_Value_From_Close_Book_Formula()
    Dim sPath As String, sFile As String, sShName As String
    sPath = "C:\Documents and Settings\" '"
    sFile = "Книга1.xls" '"
    sShName = "Лист1" '"
    Application.DisplayAlerts = 0
    With Range("A1:A100")
        .Formula = "='" & sPath & "[" & sFile & "]" & sShName & "'!" & "A1" '"
        '"A1" - указывается начальная ячейка диапазона, из которого необходимо получить значения
        .Value = .Value
    End With
    Application.DisplayAlerts = 1
End Sub

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

Sub Get_Value_From_Close_Book_Excel4Macro()
    Dim sPath As String, sFile As String, sShName As String
    Dim sAddress As String, vData
    sPath = "C:\Documents and Settings\" '"
    sFile = "Книга1.xls" '"
    sShName = "Лист1" '"
 
    sAddress = "'" & sPath & "[" & sFile & "]" & sShName & "'!" & Range("A1").Address(ReferenceStyle:=xlR1C1) '"
    vData = ExecuteExcel4Macro(sAddress)
End Sub

Если честно, сам я не очень-то люблю ни один из данных методов, т.к. они совершенно лишены гибкости. С их помощью можно получить исключительно значения ячеек. Форматы, формулы или другие свойства ячеек получить уже не получится. Поэтому я предпочитаю открывать книгу и копировать то, что мне надо. Делаю это, скрывая от пользователя при помощи свойства ScreenUpdating объекта Application.

Sub Get_Value_From_Close_Book()
    Dim sShName As String, sAddress As String, vData
    'Отключаем обновление экрана
    Application.ScreenUpdating = False
    Workbooks.Open "C:\Documents and Settings\Книга1.xls" '"
    sAddress = "A1:C100" 'или одна ячейка - "A1"
    'получаем значение
    vData = Sheets("Лист1").Range(sAddress).Value
    ActiveWorkbook.Close False
    'Записываем данные на активный лист книги,
    'с которой запустили макрос
    If IsArray(vData) Then
        [A1].Resize(UBound(vData, 1), UBound(vData, 2)).Value = vData
    Else
        [A1] = vData
    End If
    'если надо копировать ячейки с форматами, 
    'то можно использовать стандартные методы копирования вставки
    'objCloseBook.Sheets("Лист1").Range(sAddress).Copy
    '[A1].PasteSpecial xlPasteValues  'вставляем значения
    '[A1].PasteSpecial xlPasteFormats 'вставляем форматы
    'Включаем обновление экрана
    Application.ScreenUpdating = True
End Sub

Есть и более экзотический метод - при помощи GetObject:

Sub Get_Value_From_Close_Book2()
    Dim sShName As String, sAddress As String, vData
    Dim objCloseBook As Object
    'Отключаем обновление экрана
    Application.ScreenUpdating = False
    Set objCloseBook = GetObject("C:\Documents and Settings\Книга1.xls")
    sAddress = "A1:C100" 'или одна ячейка - "A1"
    'получаем значение
    vData = objCloseBook.Sheets("Лист1").Range(sAddress).Value
    objCloseBook.Close False
    'Записываем данные на активный лист книги,
    'с которой запустили макрос
    If IsArray(vData) Then
        [A1].Resize(UBound(vData, 1), UBound(vData, 2)).Value = vData
    Else
        [A1] = vData
    End If
    'если надо копировать ячейки с форматами, 
    'то можно использовать стандартные методы копирования вставки
    'objCloseBook.Sheets("Лист1").Range(sAddress).Copy
    '[A1].PasteSpecial xlPasteValues  'вставляем значения
    '[A1].PasteSpecial xlPasteFormats 'вставляем форматы
    'Включаем обновление экрана
    Application.ScreenUpdating = True
End Sub

При таком подходе пользователь разницы не увидит, а действия можно производить с ячейками разные: и сравнение, и отбор по критериям, и фильтровать, и сортировать и т.д. Плюс из книги можно переносить не только значения ячеек, но и форматы, формулы. Но выбирать метод получения значений из закрытых книг вам. Все зависит от ситуации. Все указанные коды работают. Если не работают - то проверьте верно ли указаны все исходные данные(имя книги и расширение, имя листа, путь к папке с книгой).


Получение данных из закрытой книги при помощи UDF
Тот же код, что уже был рассмотрен выше, но оформленный в виде UDF(функции пользователя):

Function Get_Value_From_Close_Book(sWb As String, sShName As String, sAddress As String)
    Dim vData, objCloseBook As Object
    Set objCloseBook = GetObject(sWb)
    'получаем значение
    vData = objCloseBook.Sheets(sShName).Range(sAddress).Value
    objCloseBook.Close False
    'Возвращаем данные в ячейку с функцией
    Get_Value_From_Close_Book = vData
End Function

Синтаксис функции (вызов с листа):
=Get_Value_From_Close_Book("C:\Книга1.xls";"Лист1";"B1")
sWb - полный путь до книги, данные из которой необходимо извлечь ("C:\Книга1.xls")
sShName - имя листа в указанной книге, данные из которого необходимо извлечь ("Лист1")
sAddress - адрес ячейки(диапазона) данные которой необходимо получить ("B1")

Чтобы получить массив ячеек(например B1:B10), необходимо выделить необходимое количество ячеек и ввести в них эту функцию, как формулу массива.
Думаю, не надо пояснять, что любой аргумент может быть задан не статичным текстом, а ссылкой на ячейку с этим текстом. Именно в этом и преимущество использования именно функций, а не процедур.


ПОЛУЧЕНИЕ ДАННЫХ ПРИ ПОМОЩИ ADO
Так же есть еще один достаточно экзотический метод получения данных из действительно закрытой книги - через ADO(ActiveX Data Objects). По сути это получение данных через запрос SQL, используя для этого технологию ADO.

'---------------------------------------------------------------------------------------
' Procedure : Extract_Value_ADO
' DateTime  : 02.07.2014 16:47
' Author    : The_Prist(Щербаков Дмитрий)
'             http://www.excel-vba.ru
' Purpose   : Функция получения данных из закрытой книги при помощи ADO
'             в таком виде не может быть использована вызовом с листа
'---------------------------------------------------------------------------------------
Function Extract_Value_ADO(sPath As String, sFileName As String, sShName As String, sRng As String)
    Dim objADO_Con As Object, objRS As Object
    Dim sFullFileName As String, sADORng As String
 
    'проверяем наличие слеша в пути к файлу
    If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
    'если ячейка только одна - меняем вид адресации на ячейка:ячейка, как того требует ADO
    If Range(sRng).Count = 1 Then
        sADORng = sRng & ":" & sRng
    Else
        sADORng = sRng
    End If
    sFullFileName = sPath & sFileName
    With CreateObject("ADODB.Connection")
        'подключаемся к файлу
        .Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};ReadOnly=1;DBQ=" & sFullFileName & ";"
        'извлекаем записи из указанного диапазона в objRS
        Set objRS = .Execute("select * FROM [" & sShName & "$" & sADORng & "]")
        'выгружаем извлеченные данные на активный лист, начиная с ячейки А1
        Cells(1, 1).CopyFromRecordset objRS
        'Extract_Value_ADO = objRS.Fields(0).Value
    End With
    Set objRS = Nothing
End Function

Вызывать эту функцию следует из другой процедуры или функции. Пример процедуры, для вызова этой функции:

'---------------------------------------------------------------------------------------
' Procedure : Get_Value_From_Close_Book_ADO
' Purpose   : Вызов функции Extract_Value_ADO
'---------------------------------------------------------------------------------------
Sub Get_Value_From_Close_Book_ADO()
    Extract_Value_ADO ThisWorkbook.path, "Книга1.xls", "Лист1", "A1:B25"
End Sub

Для вызова функции Extract_Value_ADO непосредственно с листа(в виде функции UDF) придется несколько изменить приведенный выше код функции, либо извлекать функцией значение только одной ячейки, что будет не очень экономично с точки зрения ресурсов и использование для этого ADO будет слишком неоправданным. Если кому необходимо, то для вызова функции с ячейки листа и возврата значения одной ячейки, необходимо заменить строку:

Cells(1, 1).CopyFromRecordset objRS

на такую:

Extract_Value_ADO = objRS.Fields(0).Value

Синтаксис вызова с листа в таком случае будет следующим:
=Extract_Value_ADO("C:\"; "Книга1.xls"; "Лист1"; "A1")
Важно: если данные извлекаются только из одной ячейки, то следует указать две ячейки: А1:А2. Это особенность работы с запросами

Если же необходимо извлекать данные диапазона ячеек, то в этом случае можно применить такую функцию:

'---------------------------------------------------------------------------------------
' Procedure : Extract_Value_ADO
' DateTime  : 02.07.2014 16:47
' Author    : The_Prist(Щербаков Дмитрий)
'             http://www.excel-vba.ru
' Purpose   : Функция получения данных из закрытой книги при помощи ADO
'             вызывается с листа как функция массива(если получаем данные с диапазона)
'---------------------------------------------------------------------------------------
Function Extract_Value_ADO_Sh(sPath As String, sFileName As String, sShName As String, sRng As String)
    Dim objADO_Con As Object, objRS As Object
    Dim sFullFileName As String, sADORng As String
    Dim avTmp(), avRes(), li As Long, lr As Long, lc As Long
    'проверяем наличие слеша в пути к файлу
    If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
    'если ячейка только одна - меняем вид адресации на ячейка:ячейка, как того требует ADO
    If Range(sRng).Count = 1 Then
        sADORng = sRng & ":" & sRng
    Else
        sADORng = sRng
    End If
    sFullFileName = sPath & sFileName
    With CreateObject("ADODB.Connection")
        'подключаемся к файлу
        .Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};ReadOnly=1;DBQ=" & sFullFileName & ";"
        'получаем кол-во строк в запросе
        Set objRS = .Execute("SELECT COUNT(*) FROM [" & sShName & "$" & sADORng & "]")
        li = objRS.Fields(0).Value
        'извлекаем записи из указанного диапазона в objRS
        Set objRS = .Execute("SELECT * FROM [" & sShName & "$" & sADORng & "]")
        'выгружаем извлеченные данные на активный лист, начиная с ячейки А1
        ReDim avRes(1 To li, 1 To objRS.Fields.Count)
        avTmp = objRS.getrows(li, 0)    'получаем массив данных запроса
        For lr = 0 To li - 1    'цикл по строкам
            For lc = 0 To UBound(avTmp, 1) 'цикл по столбцам
                'значения Null не допускаются, поэтому приходится их подменять до выгрузки на лист
                If IsNull(avTmp(lc, lr)) Then
                    avTmp(lc, lr) = Empty
                End If
                avRes(lr + 1, lc + 1) = avTmp(lc, lr)
            Next lc
        Next lr
    End With
 
    Extract_Value_ADO_Sh = avRes
    Set objRS = Nothing
End Function

Синтаксис вызова с листа точно такой же как и в функции выше, только нужно будет выделить необходимое количество ячеек и ввести в них эту функцию, как формулу массива.:
=Extract_Value_ADO_Sh("C:\"; "Книга1.xls"; "Лист1"; "A1:B10")
sPath - путь к папке с книгой, данные из которой необходимо извлечь ("C:\")
sWb - имя книги, включая расширение(.xls в примере), данные из которой необходимо извлечь ("Книга1.xls")
sShName - имя листа в указанной книге, данные из которого необходимо извлечь ("Лист1")
sAddress - адрес ячейки(диапазона) данные которой необходимо получить ("A1")
Важно: если данные извлекаются только из одной строки, то следует все равно указать минимум две строки: А1:B10. Это особенность работы с запросами. При попытке указать только одну строку А1:A10 функция вернет значение ошибки. При этом первая строка воспринимается как заголовки. Т.е. данные должны начинаться как минимум со второй строк(A2), а в A1 - заголовок
Хоть эта функция имеет определенные недостатки - она может быть в разы быстрее предыдущей.


Статья помогла? Поделись ссылкой с друзьями!
  Плейлист   Видеоуроки

Поиск по меткам

Access apple watch Multex Power Query и Power BI VBA управление кодами Бесплатные надстройки Дата и время Записки Надстройки Печать Политика Конфиденциальности Почта Программы Работа с приложениями Разработка приложений Тренинги и вебинары Финансовые Форматирование Функции Excel акции MulTEx ссылки
Обсуждение: 143 комментария
  1. Юра:

    Ого, вот это оперативность! Большое спасибо за статью и за разьяснения )
    По поводу ошибки при открытой второй книге: выдает ошибку 1004 и ссылается на строку .Formula. При закрытой книге работает без ощибок. Возможно из за того что второй файл на сетевом диске... В принципе не столь важно, так как нужно как раз при закрытой книге, но понять причину не помешает )

    • Проверьте получение данных из открытой книги, которая сохранена локально. Чтобы 100% отсечь ошибку системную. Что касается ошибки при обращении к открытой книге на сетевом диске - возможно, она при открытии просто блокируется сервером и код не может получить из неё данные данным методом.

  2. Юра:

    Все верно, локально работает отлично в обих случаях. Еще раз спасибо )

  3. Toivo:

    здравствуйте, а можно ли сделать так, чтобы вместо системного указателя пути и имени, пользователь сам мог при активации макроса, указать файл, из которого надо извлечь данные?

Поделитесь своим мнением

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


Для оформления сообщений Вы можете использовать следующие тэги:
<a href="" title=""> <abbr title=""> <acronym title=""> <b> <blockquote cite=""> <cite> <code> <del datetime=""> <em> <i> <q cite=""> <s> <strike> <strong>

Тренинги

Заказать
Юридическая информация

Использование материалов сайта

Политика Конфиденциальности

ИП Щербаков Дмитрий Валентинович
ОГРНИП: 318502700083307
ИНН: 504013350772

Наши партнеры

Перейти
Перейти

Счетчики

Рейтинг@Mail.ru Яндекс.Метрика
© 2020 Excel для всех   Войти