Как получить данные из закрытой книги?
Достаточно часто появляется вопрос: как извлечь данные из закрытой книги 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
|
1
2
3
4
5
6
7
8
9
10
11
12
13 |
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
|
1
2
3
4
5
6
7
8
9
10 |
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 'Включаем обновление экрана Application.ScreenUpdating = True End Sub
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19 |
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
'Включаем обновление экрана
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 'Включаем обновление экрана Application.ScreenUpdating = True End Sub
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20 |
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
'Включаем обновление экрана
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
|
1
2
3
4
5
6
7
8
9 |
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
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32 |
'---------------------------------------------------------------------------------------
' 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
|
1
2
3
4
5
6
7 |
'---------------------------------------------------------------------------------------
' 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
|
1 |
Cells(1, 1).CopyFromRecordset objRS |
на такую:
Extract_Value_ADO = objRS.Fields(0).Value
|
1 |
Extract_Value_ADO = objRS.Fields(0).Value |
Синтаксис вызова с листа в таком случае будет следующим:
=Extract_Value_ADO("C:\"; "Книга1.xls"; "Лист1"; "A1")
Важно: если данные извлекаются только из одной ячейки, то следует указать две ячейки: А1:А2. Это особенность работы с запросами
Если же необходимо извлекать данные диапазона ячеек, то в этом случае можно применить такую функцию:
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46 |
'---------------------------------------------------------------------------------------
' 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 - заголовок
Хоть эта функция имеет определенные недостатки - она может быть в разы быстрее предыдущей.
