Хитрости »
Основные понятия (23)
Сводные таблицы и анализ данных (9)
Графики и диаграммы (5)
Работа с VB проектом (12)
Power BI и Power Query (14)
Условное форматирование (5)
Списки и диапазоны (5)
Макросы(VBA процедуры) (63)
Разное (38)
Баги и глюки Excel (2)

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

Достаточно часто появляется вопрос: как извлечь данные из закрытой книги 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 Outlook Power Query и Power BI VBA работа в редакторе VBA управление кодами Бесплатные надстройки Дата и время Диаграммы и графики Записки Защита данных Интернет Картинки и объекты Листы и книги Макросы и VBA Надстройки Настройка Печать Поиск данных Политика Конфиденциальности Почта Программы Работа с приложениями Работа с файлами Разработка приложений Сводные таблицы Списки Тренинги и вебинары Финансовые Форматирование Формулы и функции Функции Excel Функции VBA Ячейки и диапазоны акции MulTEx анализ данных баги и глюки в Excel ссылки
Обсуждение: 134 комментария
  1. Павел:

    =СУММЕСЛИ(Extract_Value_ADO_Sh("C:\"; "Книга1.xls"; "Лист1"; "A1:A11");5;Extract_Value_ADO_Sh("C:\"; "Книга1.xls"; "Лист1"; "B1:B11"))
    выдаёт # ЗНАЧ. Что я делаю не так?
    Есть какая нибудь другая реальная альтернатива без открывания файла(даже в тени)? Прост у меня много файлов с одним названием и бывает что один из них даже открыт, а нужно собрать с них данные.

  2. Виталий:

    В методе с GetObject переменная, в которую загружены данные, обнуляется сразу после закрытия этого файла. Переменная глобальная типа Object, процедура выполняется из модуля, в чём может быть причина?

    • Виталий,
      vData - будет содержать значения
      objCloseBook - примет значение Nothing, т.к. объект, на который она ссылается закрыт, значит выгружен из памяти. И неважно на каком уровне объявлена эта переменная - объект закрыт, значит недоступен.

      • Виталий:

        В vData у меня загружается ListObject. Всё хорошо, но стоит закрыть файл, и в vData все поля . Пробовал и с GetObject, и с CreateObject. Специально сделал vData глобальной, думал проблема внутри процедуры.

        • Виталий, ListObject - это ссылочный объект. И если закрыть книгу - он тоже обнулится, т.к. доступа к самому объекту уже не будет. Подучите чуточку мат.часть в области работы с объектами. И еще раз напишу: хоть как объявите vData - если пытаетесь в неё загнать ссылку на объект - он обнулится при закрытии книги.

          • Виталий:

            Дмитрий, возможно, в моём случае следует перечитать ListObject в двумерный массив. Спасибо за ответы.

  3. Павел:

    Добрый день!
    Есть вопрос касательно вышеуказанного кода с использованием ScreenUpdating или GetObject. Что нужно поменять в коде, чтобы копировалось не значение, а формат? Заранее благодарю.

    • Kanffeettka:

      Здравствуйте, подскажите, пожалуйста, возможно ли при первом способе перенести и формат? Спасибо.

  4. Kanffeettka:

    Возник еще вопрос, использую третий код сверху. Когда запускаю код прямо из VB, все отлично. А когда нахожусь на листе и зыпускаю с помощью комбинации кнопок - не срабатывает. Т.е. открывает вспомогательную книгу и на ней останавливается.

  5. NadirNK:

    Дмитрий, я вытягиваю данные из закрытой книги(не открывая файл - это очень критично(долго открываются файлы, с которых мне надо прочитать данные)) - с помощью формул, в которых указываю полное имя файла и нужную мне ячейку. И у меня все получается если нет ошибки с моей стороны в определении имени листа, а точнее если пользователь не поменял имя листа(файлов более 1000). Подскажите как можно проверить наличие листа с нужным мне именем в файле, опять же не открывая его. Возможно ли это?

  6. Иван:

    Здравствуйте. Хочу применить способ №1.

    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

    Но при этом копируются только значения. Как перенести и форматы ячеек? Спасибо!

    • Иван, данным методом никак. Смотрите коды, которые идут дальше.

      • Иван:

        Дмитрий, спасибо за ответ. Читал невнимательно, прошу прощения. Выбрал вариант 3, всё работает, НО форматы ячеек все равно не переносятся. Пожалуйста подскажите, где что не так? Может нужно дополнительно что-то прописывать? Спасибо.

        • Я не знаю почему у Вас форматы не переносятся, я же не знаю что и как Вы себе там скопировали. У меня в коде есть такие строки:

              'objCloseBook.Sheets("Лист1").Range(sAddress).Copy
              '[A1].PasteSpecial xlPasteValues  'вставляем значения
              '[A1].PasteSpecial xlPasteFormats 'вставляем форматы

          надо просто раскомментировать эти строки(убрать перед ними апострофы).

          • Иван:

            Дмитрий, я копировал 3й вариант, о чем написал выше, а эти строки в 4м. Спасибо, буду пытаться приспособить их к 3му.

  7. Андрей:

    День добрый! Для получения данных (из одной ячейки) посмотрел, что удобно будет использовать вот этот код. Но есть одна проблемка... Мне его необходимо использовать в виде UDF.
    Исходный код:
    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

    Мой преобразованный код:
    Function Get_One_Value_From_Close_Book_xlsm() As Variant 'sMounth As Variant, sFile As Variant, sAddress As Variant
    Dim sWb, sYear, sShName As String
    Dim tmp As String
    Dim sMounth As String
    Dim sFile As String
    Dim sAddress As String

    sMounth = Worksheets("Ïðèõîä îò ÑÒÎ").Cells(257, 1)
    sFile = Worksheets("Ïðèõîä îò ÑÒÎ").Cells(261, 1)
    sAddress = "C15"

    sYear = Right(sMounth, 4)
    tmp = Len(sMounth) - 5
    sMounth = Left(sMounth, tmp)
    sShName = "çàêàç-íàðÿä"

    sWb = "'" & ThisWorkbook.path & "\" & sYear & "\" & sMounth & "\[" & sFile & ".xlsm]" & sShName & "'!" & Range(sAddress).Range("A1").Address(, , xlR1C1)
    Debug.Print sWb
    Get_One_Value_From_Close_Book_xlsm = ExecuteExcel4Macro(sWb)
    End Function
    На последней строке код просто перестает работать, не выбрасывая никакой ошибки. В ячейке, из которой UDF вызывается получается ошибка #ЗНАЧ!

    ПОМОГИТЕ ПЛЗ!!! В чем загвоздка. При этом когда дописал маленький SUB вызова этого же кода по нажатию кнопки, то все ок...
    Public Sub Êíîïêà17_Ùåë÷îê()
    tmp = Get_One_Value_From_Close_Book_xlsm()
    End Sub

    Но мне вариант с кнопкой не подходит... Необходимо именно UDF

    • Именно UDF показана дальше в статье - через ADO. И это единственный вариант, когда можно использовать как UDF. Остальные методы из статьи через UDF использовать нельзя, это ограничение Excel.

  8. Мультипликатор:

    Доброго времени суток!
    А можно ли вытащить значения из файла Экселя макросом в Ворде?
    Использую второй вариант, где можно только значение одной ячейки вытащить.
    Вставил в макрос в ворде, но почему то открывается папка "Библиотеки/Документы" в диалоговом окне и называется "Обновить значения:..." и имя файла.
    Возможно ли это вообще - вытащить значения ячейки из файла Экселя макросом в Ворде?
    Заранее благодарю.

  9. Василий:

    Можно ли с помощью метода GetObject открыть файл Excel из интернета, если я знаю адрес, но не знаю названия получаемого файла? Если нет, можете посоветовать какой-нибудь метод? Знаю, что можно с помощью Workbooks.Open. Но несмотря на то, что саму книгу можно скрыть, видно, как работает бегунок загрузки, несмотря на оператор Application.ScreenUpdating = False
    Ну и очень долго, конечно, хотя сам файл небольшой.

    • Не зная имени файла открыть книгу вообще нельзя. И метод Open тоже требует обязательного указания полного имени книги. И если в случае локального хранения можно хотя бы отыскать файл по маске или определить его наличие, то для файла в интернете необходимо знать точный адрес файла, скачать его и только после этого открыть(за исключением файлов в сетевом диске - они могут быть открыты).
      Как скачивать файлы из интернета я описывал в этой статье: Как скачать файл из интернета по ссылке

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

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


Для оформления сообщений Вы можете использовать следующие тэги:
<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 Яндекс.Метрика
© 2018 Excel для всех   Войти