Как получить данные из закрытой книги?
Достаточно часто появляется вопрос: как извлечь данные из закрытой книги Excel через VBA? Звучит может быть странновато, но это так: вопрос регулярно поднимается на форумах. Собственно, именно в связи с этим и появилась на свет данная статья. В принципе ничего сложного в задаче нет. При этом получить данные можно разными способами, в том числе при помощи функций пользователя(UDF).
Хотя если вдаваться в технические подробности, то получить данные из закрытой книги вообще нельзя. Так или иначе, на уровне системы файл все равно открывается, различие лишь в том как именно и к чему при этом предоставляется доступ. Поэтому переозвучим классическую постановку задачи в более распространенную в жизни: "Как получить данные из книги, не открывая её так, чтобы об этом узнал пользователь"
Попробуем разобраться с некоторыми методами, их плюсами и минусами:
- Получение данных из закрытой книги при помощи процедуры
- Получение данных из закрытой книги при помощи UDF
- Получение данных из закрытой книги при помощи запроса ADO
- Получение данных из закрытой книги при помощи Power Query
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 Dim objCloseBook As Workbook 'Отключаем обновление экрана Application.ScreenUpdating = False Set objCloseBook = Workbooks.Open("C:\Documents and Settings\Книга1.xls") sAddress = "A1:C100" 'или одна ячейка - "A1" 'получаем значение vData = Sheets("Лист1").Range(sAddress).Value 'Записываем данные на активный лист книги, 'с которой запустили макрос 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 'вставляем форматы 'закрываем книгу(из которой получали значения) без сохранения objCloseBook.Close False 'Включаем обновление экрана 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 'Записываем данные на активный лист книги, 'с которой запустили макрос 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 'вставляем форматы 'закрываем книгу(из которой получали значения) без сохранения objCloseBook.Close False 'Включаем обновление экрана Application.ScreenUpdating = True End Sub |
При таком подходе пользователь разницы не увидит, а действия можно производить с ячейками разные: и сравнение, и отбор по критериям, и фильтровать, и сортировать и т.д. Плюс из книги можно переносить не только значения ячеек, но и форматы, формулы. Но выбирать метод получения значений из закрытых книг вам. Все зависит от ситуации. Все указанные коды работают. Если не работают - то проверьте верно ли указаны все исходные данные(имя книги и расширение, имя листа, путь к папке с книгой).
Тот же код, что уже был рассмотрен выше, но оформленный в виде 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 Set objCloseBook = Nothing 'Возвращаем данные в ячейку с функцией Get_Value_From_Close_Book = vData End Function |
sWb - полный путь до книги, данные из которой необходимо извлечь (
sShName - имя листа в указанной книге, данные из которого необходимо извлечь (
sAddress - адрес ячейки(диапазона) данные которой необходимо получить (
Чтобы получить массив ячеек(например B1:B10), необходимо выделить необходимое количество ячеек и ввести в них эту функцию, как формулу массива.
Думаю, не надо пояснять, что любой аргумент может быть задан не статичным текстом, а ссылкой на ячейку с этим текстом. Именно в этом и преимущество использования именно функций, а не процедур.
Так же есть еще один достаточно экзотический метод получения данных из действительно закрытой книги - через 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 |
Синтаксис вызова с листа в таком случае будет следующим:
Если же необходимо извлекать данные диапазона ячеек, то в этом случае можно применить такую функцию:
'--------------------------------------------------------------------------------------- ' 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 |
Синтаксис вызова с листа точно такой же как и в функции выше, только нужно будет выделить необходимое количество ячеек и ввести в них эту функцию, как формулу массива.:
sPath - путь к папке с книгой, данные из которой необходимо извлечь (
sWb - имя книги, включая расширение(.xls в примере), данные из которой необходимо извлечь (
sShName - имя листа в указанной книге, данные из которого необходимо извлечь (
sAddress - адрес ячейки(диапазона) данные которой необходимо получить (
Хоть эта функция имеет определенные недостатки - она может быть в разы быстрее предыдущей.
Если еще не работали с надстройкой PowerQuery и не знаете что это такое, то для начала лучше ознакомиться со статьей: Power Query - что такое и почему её необходимо использовать в работе?
Переходим на вкладку Данные(для Excel ниже 2016 вкладка PowerQuery) -Получить данные -Из файла -Из книги
Выбираем нужный лист
Если необходимы данные всего листа, то внизу этого окна нажимаем кнопку Загрузить. Все, через пару секунд все данные выбранного листа будут помещены на новый лист текущей книги в умную таблицу.
Но если необходимо отобрать только определенные столбцы и строки - тут придется хитрить. Например, нам необходимо получить данные ячеек
Попадаем в редактор запросов PowerQuery и видим там данные нашего листа. Чтобы удалить лишние строки нам придется для начала их пронумеровать, т.к. в PowerQuery нет вменяемой нумерации строк по умолчанию.
Идем на вкладку Добавление столбца -Столбец индекса -Настроить
Теперь раскрываем фильтр на добавленном столбце индекса -Числовые фильтры -Между
Указываем "больше или равно" - 2, "меньше или равно" - 20 (это строки нужного нам диапазона
После нажатия Ок останутся только нужные нам строки. А удалить столбцы проще простого: выделяем нужные нам 3-й и 4-ый столбцы(это как C и D на листе Excel, только номерами) -правая кнопка мыши -Удалить другие столбцы.
Вуаля!
Осталось выгрузить в нашу книгу: идем на вкладку Главная -Закрыть и загрузить.
В дальнейшем надо будет просто выделить любую ячейку этой полученной из PowerQuery умной таблицы правой кнопкой мыши и нажать обновить.
Находим там строку:
Это и есть наша строка удаления всех столбцов, кроме указанных в фигурных скобках(
этой строкой мы получаем список всех имен столбцов и запоминаем в список ColNames. А далее мы используем этот список для указания нужных номеров:
Только необходимо обращать внимание, что здесь индексация идет с 0. Т.е. если нам нужным были столбцы С(3) и D(4), то мы указываем на 1 меньше: 2 и 3. Если столбцов будет больше - перечисляем через запятые все, которые надо оставить. Зато теперь наш запрос не зависит ни от чего и мы в итоге получаем именно то, что хотим.
Статья помогла? Поделись ссылкой с друзьями!

Поиск по меткам
Access apple watch Multex Power Query и Power BI VBA управление кодами Бесплатные надстройки Дата и время Записки ИП Надстройки Печать Политика Конфиденциальности Почта Программы Работа с приложениями Разработка приложений Росстат Тренинги и вебинары Финансовые Форматирование Функции Excel акции MulTEx ссылки статистикаКомментарии, не имеющие отношения к комментируемой статье, могут быть удалены без уведомления и объяснения причин. Если есть вопрос по личной проблеме - добро пожаловать на Форум
Ого, вот это оперативность! Большое спасибо за статью и за разьяснения )
По поводу ошибки при открытой второй книге: выдает ошибку 1004 и ссылается на строку .Formula. При закрытой книге работает без ощибок. Возможно из за того что второй файл на сетевом диске... В принципе не столь важно, так как нужно как раз при закрытой книге, но понять причину не помешает )
Проверьте получение данных из открытой книги, которая сохранена локально. Чтобы 100% отсечь ошибку системную. Что касается ошибки при обращении к открытой книге на сетевом диске - возможно, она при открытии просто блокируется сервером и код не может получить из неё данные данным методом.
Все верно, локально работает отлично в обих случаях. Еще раз спасибо )
здравствуйте, а можно ли сделать так, чтобы вместо системного указателя пути и имени, пользователь сам мог при активации макроса, указать файл, из которого надо извлечь данные?
Можно. Вопрос только в том насколько глубоки Ваши познания в VBA и как Вы хотите, чтобы пользователь выбирал файл. На сайте есть статьи и про диалоговые окна выбора файла и про обычный Inputbox:
Работа с диалогами
Диалоговое окно выбора файлов/папки
Подскажите, а как получить значения нескольких ячеек из книг, названия которых прописаны в строках таблицы на текущем листе. Путь для всех один.
For i = 2 to 100
файл = Worksheets. Cells (i,2)
Workbooks.Open "C:\Documents and Settings\ "& файл'" - так не выходит
sAddress = "A1:C100" 'или одна ячейка - "A1"
'получаем значение
vData = Sheets("Лист1").Range(sAddress).Value
ActiveWorkbook.Close False
вот это вот уже не должно работать, т.к. необходимо указать имя листа. Сама по себе коллекция Worksheets не имеет объекта Cells.
Плюс, для перебора все же лучше использовать обращение через переменные:
Подскажите, пожалуйста! использую метод Extract_Value_ADO_Sh(sPath As String, sFileName As String, sShName As String, sRng As String). Получилось все настроить и вызов функции с листа, тоже работает корректно. Но как мне сделать вызов функции через VBA. Я хочу в коде, создавать новый лист на этот листы вставлять вызванные значения.
Данил, так это практически так же как и при вызове с листа делается:Range("A1").Value = Extract_Value_ADO("C:\", "Книга1.xls", "Лист1", "A1")
Но раз вызываете из VBA, то Вам лучше использовать функцию, приведенную в статье чуть выше: Extract_Value_ADO. Она сразу запишет на лист все полученные данные, начиная с указанной ячейки.
Вот этот макрос:
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
Просто закрывает Эксель в моём случае :) Висит и вылетает. Правда стараюсь взять данные из книги с макросами, а не из обычной. Это может являться причиной вылета?
Здравствуйте. Подскажите как в вашем примере в квадратные скобки вставить переменную
["N"].Resize(UBound(vData1, 1), UBound(vData1, 2)).Value = vData1
Нужно взять не сплошной массив, а составной:
sAddress1 = ("A5:A15")
sAddress2 = ("C5:E15")
sAddress3 = ("F5:H15")
Это решил таким образом, разбил на vData1, 2, 3, записал 3 строчки, криво, наверно, но работает. А вот сдвинуть следующие записи не могу.
В общем нужно в папке из 20 файлов выписать определенные диапазоны на один лист. Если сюда [A1] вставить переменную, то можно в цикле двигать до нижней границы.
Используйте классический способ обращения к диапазону:
правда несвязанные диапазоны так вставить не получится и все равно придется разбивать на три строки.
Здравствуйте. Не могу решить задачу по изыманию формата искомой ячейки из закрытой книги, т.е. аналог функции ВПР, но возвращающей свойство NumberFormatLocal вместо Value. Дело в том, что 1С выгружает код валюты в виде пользовательского формата к валютной цене, для пересчёта цены в рубли нужного артикула требуется знать в какой валюте цена. Сделал монстра ФОРМАТЯЧЕЙКИ(ДВССЫЛ([База.xlsx]Лист1!R"&ПОИСКПОЗ(RC[-1];Extract_Value_ADO_Sh("C:\"; "База.xlsx"; " Лист1"; "b1:b10000");0)+1&"C4";))
Function ФОРМАТЯЧЕЙКИ(ЯЧЕЙКА As Range) As String
ФОРМАТЯЧЕЙКИ = ЯЧЕЙКА.NumberFormatLocal
End Function
но даже он со всей своей жуткой медлительностью работает только при открытой "базе" с формулой для массива и без - результата нет.
понял, что даже функция ДВССЫЛ не работает с закрытой книгой... всё было тщетно изначально, и похоже нужно писать собственную функцию ВПР с форматом вместо значения, на что у меня не хватает знания.
Из закрытой книги форматы не получить. используйте код Get_Value_From_Close_Book2 - там в комментариях прописано как получить ячейки с форматами. Других вариантов нет.
А возможно ли открыть файл, размещённый на OneDrive другого пользователя (т.е. не на локальном ПК)? Может быть есть возможность обратиться к истории файлов Excel? Например, нужный файл ранее уже открывался на локальном ПК.
Евгений, если локально файл тоже не существует, то через VBA вообще вряд ли получится. Только если применить Power Query. А т.к. это файл другого пользователя - нужен либо предоставленный к файлу доступ(т.е. чтобы файл был расшарен), либо полные учетные данные того пользователя.
Дмитрий, удалось открыть файл методом
Workbooks.Open Filename:="https://d.docs.live.net/.../Dir1/FileName.xlsx"
Предварительно, конечно, пользователю были представлены права на изменение файла.
Тестировал на MSO365 Home. Позже смогу проверить на Excel 2019.
Выборка данных sql ADO - "Проблема с апострофами в наименовании листов книги"
Возможно это уже обсуждалось, тем не мене может кому пригодится:
Обратил внимание, на то, что если в наименовании листа есть пробел "Лист 1" или "Отчет квартальный",
в запросе на листы книги наименование возвращается с апострофами 'Лист 1' или 'Отчет квартальный'
Set tables = .OpenSchema(20) ' запрос на таблицу листов книги
'Do Until tables.EOF ' перебор листов книги
' MsgBox tables(2) ' 2-возвращает наименование листа книги
'Loop
ShtNm = tables(2) ' выбираем наименование первого по умолчанию листа книги
По этой причине в запросе на выборку данных возникает ошибка:
Set objRS = .Execute("select * FROM [" & ShtNm & sADORng & "]")
Если убрать апострофы все работает корректно:
ShtNm = tables(2) ' выбираем наименование первого по умолчанию листа книги
' При наличии апострофов "'" в наименования листа убираем их
For y = 1 To Len(tables(2))
If Mid(tables(2), y, 1) = Chr(32) Then ShtNm = Mid(tables(2), 2, Len(tables(2)) - 2): Exit For
Next
Замечание дельное, но не понял какое оно имеет отношение к статье? В приведенном мной коде нигде про апострофы речи нет - если сами их не добавите они нигде не появятся. Следовательно совершенно неясно что Вы тут чинить собрались :)