Макрос подключение sql excel

Представьте себе ситуацию, Вы получили целевую выборку из одной базы данных, но для полноты картины, как всегда, нужны дополнительные данные. Проблема может быть в том, что нужная информация хранится в другой базе данных и возможности создать на ней свою таблицу нет, подключиться используя link тоже нельзя, да и количество элементов, по которым нужно получить данные, несколько больше, чем допустимое на данном источнике. Вот и получается, что возможность написать SQL запрос и получить нужные данные есть, но написать придется не один запрос, а потом потратить время на объединение полученных данных.

Выйти из подобной ситуации поможет Excel.

Уверен, что ни для кого не секрет, что MS Excel имеет встроенный модуль VBA и надстройки, позволяющие подключаться к внешним источникам данных, то есть по сути является мощным инструментом для аналитики, а значит идеально подходит для решения подобных задач.

Для того чтобы обойти проблему, нам потребуется таблица с целевой выборкой, в которой содержатся идентификаторы, по которым можно достаточно корректно получить недостающую информацию (это может быть уникальный идентификатор, назовем его ID, или набор из данных, находящихся в разных столбцах), ПК с установленным MS Excel, и доступом к БД с недостающей информацией и, конечно, желание получить ту самую информацию.

Создаем в MS Excel книгу, на листе которой размещаем таблицу с идентификаторами, по которым будем в дальнейшем формировать запрос (если у нас есть уникальный идентификатор, для обеспечения максимальной скорости обработки таблицу лучше представить в виде одного столбца), сохраняем книгу в формате *.xlsm, после чего приступаем к созданию макроса.

Через меню «Разработчик» открываем встроенный VBA редактор и начинаем творить.

Sub job_sql() — Пусть наш макрос называется job_sql.

Пропишем переменные для подключения к БД, записи данных и запроса:

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sql As String

Опишем параметры подключения:

sql = «Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Data Source=Storoge.company.ru Storoge.»

Объявим процедуру свойства, для присвоения значения:

Set cn = New ADODB.Connection
cn.Provider = » SQLOLEDB.1″
cn.ConnectionString = sql
cn.ConnectionTimeout = 0
cn.Open

Вот теперь можно приступать непосредственно к делу.

Организуем цикл:

For i = 2 To 1000

Как вы уже поняли конечное значение i=1000 здесь только для примера, а в реальности конечное значение соответствует количеству строк в Вашей таблице. В целях унификации можно использовать автоматический способ подсчета количества строк, например, вот такую конструкцию:

Dim LastRow As Long
LastRow = ActiveSheet.UsedRange.Row — 1 + ActiveSheet.UsedRange.Rows.Count

Тогда открытие цикла будет выглядеть так:

For i = 2 To LastRow

Как я уже говорил выше MS Excel является мощным инструментом для аналитики, и возможности Excel VBA не заканчиваются на простом переборе значений или комбинаций значений. При наличии известных Вам закономерностей можно ограничить объем выгружаемой из БД информации путем добавления в макрос простых условий, например:

If Cells(i, 2) = «Ваше условие» Then

Итак, мы определились с объемом и условиями выборки, организовали подключение к БД и готовы формировать запрос. Предположим, что нам нужно получить информацию о размере ежемесячного платежа [Ежемесячный платеж] из таблицы [payments].[refinans_credit], но только по тем случаям, когда размер ежемесячного платежа больше 0

sql = «select [Ежемесячный платеж] from [PAYMENTS].[refinans_credit] » & _
«where [Ежемесячный платеж]>0 and [Номер заявки] ='» & Cells(i, 1) & «‘ «

Если значений для формирования запроса несколько, соответственно прописываем их в запросе:

«where [Ежемесячный платеж]>0 and [Номер заявки] = ‘» & Cells(i, 1) & «‘ » & _
» and [Дата платежа]='» & Cells(i, 2) & «‘»

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

Cells(i, 3) = sql

в третьем столбце записываются запросы.

Выполняем SQL запрос:

Set rs = cn.Execute(sql)

А чтобы хоть как-то наблюдать за выполнением макроса выведем изменение i в статус-бар

Application.StatusBar = «Execute script …» & i
Application.ScreenUpdating = False

Теперь нам нужно записать полученные результаты. Для этого будем использовать оператор Do While:

j = 0
Do While Not rs.EOF
For ii = 0 To rs.Fields.Count — 1
Cells(i, 4 + j + ii) = rs.Fields(0 + ii) ‘& «;»

Указываем ячейки для вставки полученных данных (4 в примере это номер столбца с которого начинаем запись результатов)

Next ii
j = j + rs.Fields.Count
s.MoveNext
Loop
rs.Close
End If

— закрываем цикл If, если вводили дополнительные условия

Next i
cn.Close
Application.StatusBar = «Готово»
End Sub

— закрываем макрос.

В дополнение хочу отметить, что данный макрос позволяет обращаться как к БД на MS SQL так и к БД Oracle, разница будет только в параметрах подключения и собственно в синтаксисе SQL запроса.

В приведенном примере для авторизации при подключении к БД используется доменная аутентификация.

А как быть если для аутентификации необходимо ввести логин и пароль? Ничего невозможного нет. Изменим часть макроса, которая отвечает за подключение к БД следующим образом:

sql = «Provider= SQLOLEDB.1;Password=********;User ID=********;Data Source= Storoge.company.ru Storoge;APP=SFM»

Но в этом случае при использовании макроса возникает риск компрометации Ваших учетных данных. Поэтому лучше программно удалять учетные данные после выполнения макроса. Разместим поля для ввода пароля и логина на листе и изменим макрос следующим образом:

sql = «Provider= SQLOLEDB.1;Password=» & Sheets(«Лист аутентификации»).TextBox1.Value & «;User ID=» & Sheets(«Лист аутентификации «).TextBox2.Value & «;Data Source= Storoge.company.ru Storoge;APP=SFM»

Место для расположения текстовых полей не принципиально, можно расположить их на листе с таблицей в первых строках, но мне удобней размещать поля на отдельном листе. Чтобы введенные учетные данные не сохранялись вместе с результатом выполнения макроса в конце исполняемого кода дописываем:

Sheets(«Выгрузка»).TextBox1.Value = «« Sheets(»Выгрузка«).TextBox2.Value = »»

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

Вот такое вполне жизнеспособное решение, позволяющее сократить трудозатраты при получении и обработке данных, я использую. Надеюсь мой опыт применения SQL запросов в Excel будет полезен и вам в решении текущих задач.

Источник

When it comes to big amount of data, Excel application is not the best solution to work with, in case of storage. Much better fit would be a database like Access or MSSM. In this article I’m going to show You how to connect to Microsoft SQL Server using VBA.

Database & server

In my case I got AdventureWorks2016 database installed on my PC. I connected to that base and the view of Object Explorer in Managament Studio looks like this.

Here You can see the server name, database name and tables name in Tables folder, which all will be necessary in further steps.

References

To be able to create connection and then operate on pulled data from database, You need to check in the Tools/References 2 checkboxes: Microsoft ActiveX Data Objects Library and Microsoft ActiveX Data Objects Recordset Library.

It doesn’t have to be the version 2.8, just like in the screen above. You have much more possibilities.

When choosing the references try to think about the future users (ot their Office version) of this code You create.

ADODB Connection

After setting up the references You can declare connection of ADODB library.

Dim connection As ADODB.connection
Set connection = New ADODB.connection

Connection String

This is the main thing of ADODB connection, to be able to connect to the database. You need to know at least the provider, server name, database name and authentication method.

For MS SQL use SQLOLEDB.1 as provider. That should always work, unless You know that the provider for your database is different.

The server name You can see at the top of the object explorer.

So in my case it is (LocalDb)LocalDbTest.

Let server_name = "(LocalDb)LocalDbTest"

The database name is the name under the Databases folder tree in Object Explorer.

In my case this is AdventureWorks2016.

Let database_name = "AdventureWorks2016"

The authentication method depends on that if You pass the credentials in the connection string or use windows authentication and on provider. You can choose from the values: true , false, yes, no and sspi.

So putting all together it can look like this.

.ConnectionString = "Provider=SQLOLEDB.1;Server=" & server_name & _
    ";database=" & database_name & ";Integrated Security=SSPI;"

Solution to connect local database

In case of MS SQL use SQLOLEDB.1 as provider, but if You got your database locally, as I have, go with SQLNCLI11. This is something I was fighting with and looking for hours to connect.

.ConnectionString = "Provider=SQLNCLI11;Server=" & server_name & _
    ";database=" & database_name & ";Integrated Security=SSPI;"

Open connection & state check

After completing the connection string, You can also set other properties like timeout. In the end open the connection using .Open.

With connection
    .ConnectionString = "Provider=SQLNCLI11;Server=" & server_name & _
        ";database=" & database_name & ";Integrated Security=SSPI;"
    .ConnectionTimeout = 10
    .Open
End With

If there was no error check the state of database You connected.

If connection.State = 1 Then
    Debug.Print "Connected!"
End If

SQL query

Having opened database connection You need to ask for data, I mean to build SQL query. In my case I just want to take all (*) data from TestTable table. The database name in this query is not really needed, because it is already in the connection string.

Dim sqlQuery As String
sqlQuery = "Select * from [AdventureWorks2016].[dbo].[TestTable]"

If You are not familiar with SQL I can say that the basics are even easier than VBA. As I said, basics of SQL.

Recordset – copy paste data from database

If You want to get the data from the query, You need to create Recordset of ADODB library. There are 2 main things – sqlQuery and connection. About the rest of properties You can read here.

Dim rsSql As New ADODB.Recordset
rsSql.CursorLocation = adUseClient
rsSql.Open sqlQuery, connection, adOpenStatic

After You .Open the recordset – get the data from database with SQL query using created connection, You can paste everything in chosen location.

ThisWorkbook.Sheets(1).Range("A1").CopyFromRecordset rsSql

And just like that all the data from the specified table is in the chosen range of your Workbook.

And remember that this method is not pasting headers, only the values of the columns below headline!

Connect to MS SQL code

Option Explicit

Sub connect2mssql()

Dim connection As ADODB.connection
Set connection = New ADODB.connection

Dim server_name As String, database_name As String
Let server_name = "(LocalDb)LocalDbTest"
Let database_name = "AdventureWorks2016"


With connection
    .ConnectionString = "Provider=SQLNCLI11;Server=" & server_name & _
        ";database=" & database_name & ";Integrated Security=SSPI;"
    'SQLOLEDB.1
    .ConnectionTimeout = 10
    .Open
End With

If connection.State = 1 Then
    Debug.Print "Connected!"
End If

Dim sqlQuery As String
sqlQuery = "Select * from [AdventureWorks2016].[dbo].[TestTable]"

Dim rsSql As New ADODB.Recordset
rsSql.CursorLocation = adUseClient
rsSql.Open sqlQuery, connection, adOpenStatic

ThisWorkbook.Sheets(1).Range("A1").CopyFromRecordset rsSql

End Sub

So, this is how You connect to Microsoft SQL Server using Excel VBA!

At first sight it seems like complex stuff, but in the end it is not that hard and it opens wide range of possibilities to automate data from other sources than only Excel workbooks. Combining the VBA knowledge with some more complex SQL queries can lead to really big tools dealing with tons of data. It is much easier to connect to the source than converting the data to Excel format and then start the macro. Also it speeds up the whole work a lot.

I’m very advanced in VBA, Excel, also easily linking VBA with other Office applications (e.g. PowerPoint) and external applications (e.g. SAP). I take part also in RPA processes (WebQuery, DataCache, IBM Access Client Solutions) where I can also use my SQL basic skillset. I’m trying now to widen my knowledge into TypeScript/JavaScript direction.
View all posts by Tomasz Płociński

Источник

Работа с внешними источниками данных

Материалы по работе с внешними источниками данных на примере Excel и SQL.

Рассмотрим способы передачи данных между Excel и внешней базой данной на SQL сервере с помощью ADO.

Задача первая. Подключаемся к внешней базе данных.

Для начала надо подключиться к внешней базе данных. Подключение возможно если на компьютере установлен драйвер. Список установленных драйверов для подключения к базам данных на компьютере под управлением Windows: 

Панель управленияВсе элементы панели управленияАдминистрированиеИсточники данных (ODBC)

Проверить подключение к базе данных можно простым способом. Создаем пустой файл (например, «текстовый документ.txt»), затем изменяем имя и расширение на .udl (например, «connect.udl»). Двойной клик мышкой по новому файлу, далее приступаете к настройке и проверке подключения к базе данных. После того, как удалось настроить корректное подключение к базе данных, сохраняем файл «connect.udl». Открываем файл «connect.udl» обычным текстовым редактором (например, блокнотом), и видим в строке подключения все необходимые параметры. Про подключение к внешним базам данных можно посмотреть на ресурсе ConnectionStrings .

Теперь возвращаемся к нашему VBA для Excel. В редакторе VBA подключаем последнюю версию библиотеки: 

 Microsoft ActiveX Data Objects Library

Пример кода: 

Sub TestConnection()
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.ConnectionString = "" 'Параметры строки подключения
cn.Open   'Открываем подключение
cn.Close   'Закрываем подключение
Set cn = Nothing   'Стираем объект из памяти
End Sub

Задача вторая. Загружаем данные из внешней базы данных на SQL сервере в Excel.

После того, как мы установили подключение к внешней базе данных можно приступать к чтению данных и выводу в Excel. Здесь потребуется знание языка запросов SQL. В результате выполнения SQL запроса к нам возвращается некая таблица с данными в объект RecordSet. Далее из объекта RecordSet можно выгружать данные непосредственно на лист или в сводную таблицу.

Пример кода простой процедуры: 

Sub LoadData()

Dim cn As ADODB.Connection
Dim rst As ADODB.Recordset

Set cn = New ADODB.Connection
Set rst = New ADODB.Recordset

cn.ConnectionString = "" 'Параметры строки подключения
cn.Open

rst.Open "SELECT TOP 10 * FROM <таблица>", cn 'SQL-запрос, подключение

ActiveSheet.Range("A1").CopyFromRecordset rst 'Извлекаем данные на лист

rst.Close
cn.Close

Set rst = Nothing
Set cn = Nothing

End Sub

Для удобства работы. Предлагаю создать собственный класс «tSQL» для работы с базой данных.  У класса будет одно свойство: 

Public ConnectionSring As String

Для чтения данных напишем метод SelectFrom с параметрами TableName и ws. TableName — это имя таблицы, откуда будем считывать данные и ws — лист Excel, куда будем записывать данные. 

Public Sub SelectFrom(TableName As String, ws As Worksheet)

Dim cn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim SQLstring As String
Dim i As Long

Set cn = New ADODB.Connection
Set rst = New ADODB.Recordset
SQLstring = "SELECT * FROM " & TableName
ws.Cells.Clear

cn.ConnectionString = ConnectionSring
cn.Open

rst.Open SQLstring, cn

For i = 1 To rst.Fields.Count
 ws.Cells(1, i) = rst.Fields(i - 1).Name
Next i
ws.Range("A2").CopyFromRecordset rst

rst.Close
cn.Close

Set rst = Nothing
Set cn = Nothing
SQLstring = Empty
i = Empty

End Sub

Пример использования класса tSQL в процедуре 

Sub mySQL()
Dim ts As tSQL
Set ts = New tSQL

ts.ConnectionSring = '<Строка подключения>
ts.SelectFrom "Название таблицы", ActiveSheet

Set ts = Nothing
End Sub

Задача третья. Загружаем данные из Excel во внешнюю базу данных.

Для записи данных напишем метод InsertInto с параметрами TableName. rHead и rData. TableName — это имя таблицы, куда будем добавлять данные;  rHead — диапазон ячеек, с указанием полей; rData — диапазон ячеек с данными, которые будем добавлять. 

Public Sub InsertInto(TableName As String, rHead As Range, rData As Range)

Dim cn As ADODB.Connection
Dim SQLstring As String
Dim SQLstringH As String
Dim SQLstringV As String
Dim i As Long
Dim j As Long

Dim arrHead()
Dim arrData()

arrHead = rHead.Value
arrData = rData.Value
Set cn = New ADODB.Connection
cn.ConnectionString = ConnectionSring
cn.Open

SQLstringH = "INSERT INTO " & TableName & "("
For j = LBound(arrHead, 2) To UBound(arrHead, 2)
 SQLstringH = SQLstringH & " " & arrHead(1, j)
 If j < UBound(arrHead, 2) Then
 SQLstringH = SQLstringH & ","
 Else
 SQLstringH = SQLstringH & ")"
 End If
Next j
SQLstringH = SQLstringH & " VALUES("

For i = LBound(arrData, 1) To UBound(arrData, 1)
 For j = LBound(arrData, 2) To UBound(arrData, 2)
 SQLstringV = SQLstringV & " " & arrData(i, j)
 If j < UBound(arrHead, 2) Then
 SQLstringV = SQLstringV & ","
 Else
 SQLstringV = SQLstringV & ") "
 End If
 Next j
 SQLstring = SQLstringH & SQLstringV
 SQLstringV = Empty
 cn.Execute SQLstring
Next i
cn.Close

Set cn = Nothing
SQLstring = Empty
i = Empty
j = Empty
SQLstring = Empty
SQLstringH = Empty
SQLstringV = Empty
Erase arrHead
Erase arrData

End Sub

Пример использования класса tSQL в процедуре 

Sub mySQL()
Dim ts As tSQL
Set ts = New tSQL

ts.ConnectionSring = '<Строка подключения>
ts.InsertInto "Название таблицы", Range("B1:D1"), Range("B8:D300")

Set ts = Nothing
End Sub

 

Задача четвертая. Управляем внешней базой данных из Excel

Рекомендую использовать запросы в основном для чтения данных из внешней БД. Можно записывать данные в таблицы внешней БД.
Но крайне не желательно использовать Excel для управления внешней базой данных, лучше использовать стандартные средства разработки.

Полезные ссылки:

Data from Excel to SQL 

 http://www.excel-sql-server.com/excel-sql-server-import-export-using-vba.htm

Источник

UPDATE 21.10.15 Добавил «обратный» макрос — VBA в SQL и макрос для доступа к строке запроса SQL

Некоторое время назад я прошел несколько курсов по SQL. И мне было очень интересно — какую часть из мощного инструмента под названием T-SQL можно применять без использования SQL-Server (не дают мне сервачек под мои нужды, хнык-хнык).

Итак… Начнем с простого — подключение через Query Table в VBA. Можно записать через макрорекордер — для этого нужно создать подключение через Microsoft Query.

Microsoft Query

Выбираем Excel Files, указываем путь к файлу (пытаясь при этом не ругать разработчиков за интерфейс из 90х годов), фильтруем как-угодно поля. Нам сейчас это не важно — главное получить код, который дальше можно будет корректировать.

Должно получится что-то вроде этого:

Sub Макрос1()
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
        "ODBC;DSN=Excel Files;DBQ=D:DropboxExcelтест excel_SQL-2015.xlsx;DefaultDir=D:DropboxExcel;DriverId=1046;MaxBufferSize=2048;Page" _
        ), Array("Timeout=5;")), Destination:=Range("$A$1")).QueryTable
        .CommandType = 0
        .CommandText = Array( _
        "SELECT Продажи.F2, Продажи.F3" & Chr(13) & "FROM `D:DropboxExcelтест excel_SQL-2015.xlsx`.Продажи Продажи" _
        )
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Таблица_Запрос_из_Excel_Files"
        .Refresh BackgroundQuery:=False
    End With
End Sub

Строчка .CommandText = «SELECT…» — отвечает за SQL запрос. Если хотя бы немного почитать поисковую выдачу google по запросу QueryTable можно упростить код до следующего:

Sub CopyFromRecordset_To_Range()
  
  DBPath = "C:InputData.xlsx"
  sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes';"
  Conn.Open sconnect
  sSQLSting = "SELECT * FROM [Sheet1$]"

  rs.Open sSQLSting, Conn
  Set QT1 = ActiveSheet.QueryTables.Add(rs, Range("A1"))
  QT1.Refresh

  rs.Close
  Conn.Close

End Sub

Теперь начинаем копаться глубже — какого уровня запросы можно строить из VBA. Самые-самые базовые, основные конструкции — все работает, все ок.

Заполнение нового столбца одинаковым значением

SELECT  'YTikhonov', * 
FROM    [Sheet1$]

Переименование столбцов

SELECT  [Advertiser] AS 'Рекламодатель', [Quantity] AS 'Количество'
FROM    [Sheet1$]

Фильтрация записей

SELECT  * 
FROM    [Sheet1$]
WHERE   [Year] = 2014

Сортировка

SELECT   * 
FROM     [Sheet1$]
ORDER BY [Advertiser] DESC

Агрегация записей

SELECT   [Advertiser], Sum([Cost]) 
FROM     [Sheet1$]
GROUP BY [Advertiser]

Работа с датой

Дату можно впрямую через конструкцию

[SomeDateField] = {ts '2015-01-01 00:00:00'}

Но я люблю отталкиваться от текущей даты. За пару текущая дата-время отвечает функция SYSDATETIME() и она может вернуть в том числе текущий день. Для этого нужна еще одна функция  — CONVERT(type,value)

SELECT CONVERT(date,SYSDATETIME())

С функцией DATEFROMPARTS строка запроса в Excel почему-то не дружит, поэтому придется использовать костыли функцию DATEADD:

DATEADD(minute, 59, DATEADD(hour, 23, DATEADD(month, MONTH(SYSDATETIME())+1, DATEADD(year, YEAR(SYSDATETIME()) - 1900, 0))))-1

Эта строчка в любой день октября 2015 вернет значение — 30.11.15 23:59

А теперь — немного best practice!

Объединение + Агрегация + Join + Подзапросы. И самое интересное — подключение к нескольким источникам:

SELECT [Year], O.Numbers, SCost, SVolume, SQuantity FROM
 (
  SELECT [Year], Month, SUM([Cost RUB]) AS SCost, SUM(Volume) AS SVolume, SUM(Quantity) AS SQuantity FROM
   (
     SELECT Advertiser, 2013 as [Year], Month, [Cost RUB], Quantity, Volume
     FROM [N:GKRadioМаркетингСлужебный2013.xlsb].[Мониторинг$]
      UNION
     SELECT Advertiser, 2014 as [Year], Month, [Cost RUB], Quantity, Volume
     FROM [N:GKRadioМаркетингСлужебный2014.xlsb].[Мониторинг$]
       UNION
     SELECT Advertiser, 2015 as [Year], Month, [Cost RUB], Quantity, Volume
     FROM [N:GKRadioМаркетингСлужебный2015.xlsb].[Мониторинг$]
   )
   WHERE [Advertiser] = 'METRO GROUP'
   GROUP BY [Year], Month
 ) as T INNER JOIN [C:testMonth.xlsb].[Test$] AS O
ON T.[Month] = O.[Month]

Одна проблема — если осуществлять такого вида запрос для соединения нескольких Excel-файлов, он будет выполняться достаточно медленно. У меня вышло порядка 2 минут. Но не стоит думать что это бесполезно — если подобные запросы выполнять при подключении к SQL-серверу, то время обработки будет 1-2 секунды (само собой, все зависит от сложности запроса, базы, и прочие прочие факторы).

Бонусы

Формировать более-менее сложный запрос SQL вручную в VBA мягко говоря неудобно.  Поэтому я написал мини-макрос, который берет информацию из буфера обмена, и возвращает туда строчки для вставки в VBE.

'работа с буфером обмена http://excelvba.ru/code/clipboard
Private Function ClipboardText() ' чтение из буфера обмена
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .GetFromClipboard
        ClipboardText = .GetText
    End With
End Function
 
Private Sub SetClipboardText(ByVal txt$) ' запись в буфер обмена
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .SetText txt$
        .PutInClipboard
    End With
End Sub

Public Sub SQL_String_To_VBA()
  
    Dim sInput As String, sOut As String
    Dim ArrInput, i As Integer
    
    Dim cIdent As Integer: cIdent = 1 'Count of tabs
    Dim sVar As String: sVar = "strSQL" 'Name of variable
      
    sInput = ClipboardText()
    
    ArrInput = Split(sInput, Chr(13))
    
    For i = LBound(ArrInput) To UBound(ArrInput)
        sOut = sOut & sVar & " = " & sVar & " & " & Chr(34)
        sOut = sOut & String(cIdent, Chr(9))
        sOut = sOut & Replace(ArrInput(i), Chr(10), "")
        sOut = sOut & Chr(34) & "& chr(10)" & Chr(10)
    Next i
    
    SetClipboardText (sOut)

End Sub

Public Sub VBA_String_To_SQL()
 
    Dim sInput As String, sOut As String
    Dim ArrInput, i As Integer, sTemp
 
    sInput = ClipboardText()
 
    ArrInput = Split(sInput, Chr(10))
 
    For i = LBound(ArrInput) To UBound(ArrInput)
      sTemp = Replace(ArrInput(i), "& chr(10)", "")
      If Right(sTemp, 1) = " " Then sTemp = Left(sTemp, Len(sTemp) - 1)
      If Right(sTemp, 1) = Chr(34) Then sTemp = Left(sTemp, Len(sTemp) - 1)
 
      If Len(sTemp) > 0 Then
        sTemp = Right(sTemp, Len(sTemp) - InStr(1, sTemp, Chr(34)))
        sOut = sOut & Chr(10) & sTemp
      End If
    Next i
 
    SetClipboardText (sOut)

End Sub

Сами запросы просто и удобно создавать, например, используя Notepad++. Создали многострочный запрос SQL, копируете его в буфер обмена, запускаете макрос и вуаля — в буфере обмена строчки кода, готовые для вставки в ваши макросы. При желании вы можете настроить название переменной и количество табуляций.

И еще один небольшой бонус. Если у вас есть отчет по менеджерам/руководителям, построенный на запросах, то вам наверняка потребуется получать доступ к строке запроса через VBA. Сделать это можно через замечательную команду .CommandText — работает на чтение и запись. Мне для формирования отчета на 25 человек очень пригодился.

Public Sub ReplaceCommandText()
 
Dim con As WorkbookConnection
Dim sTemp As String
 
  For Each con In ActiveWorkbook.Connections
    sTemp = con.ODBCConnection.CommandText
    con.ODBCConnection.CommandText = sTemp
    con.Refresh
  Next con
 
End Sub

PS Ссылка с ответом на вопрос — как вставить данные из Excel в SQL
https://www.simple-talk.com/sql/t-sql-programming/questions-about-using-tsql-to-import-excel-data-you-were-too-shy-to-ask/

Приятного использования!

Источник

Время прочтения: 5 мин.

Наша работа неразрывно связана с получением и анализом информации из разных источников. Представьте себе ситуацию, Вы получили целевую выборку из одной базы данных, но для полноты картины, как всегда, нужны дополнительные данные. Проблема может быть в том, что нужная информация хранится в другой базе данных и возможности создать на ней свою таблицу нет, подключиться используя link тоже нельзя, да и количество элементов, по которым нужно получить данные, несколько больше, чем допустимое на данном источнике. Вот и получается, что возможность написать SQL запрос и получить нужные данные есть, но написать придется не один запрос, а потом потратить время на объединение полученных данных.

Выйти из подобной ситуации поможет Excel.

Уверен, что ни для кого не секрет, что MS Excel имеет встроенный модуль VBA и надстройки, позволяющие подключаться к внешним источникам данных, то есть по сути является мощным инструментом для аналитики, а значит идеально подходит для решения подобных задач.

Для того чтобы обойти проблему, нам потребуется таблица с целевой выборкой, в которой содержатся идентификаторы, по которым можно достаточно корректно получить недостающую информацию (это может быть уникальный идентификатор, назовем его ID, или набор из данных, находящихся в разных столбцах), ПК с установленным MS Excel, и доступом к БД с недостающей информацией и, конечно, желание получить ту самую информацию.

Создаем в MS Excel книгу, на листе которой размещаем таблицу с идентификаторами, по которым будем в дальнейшем формировать запрос (если у нас есть уникальный идентификатор, для обеспечения максимальной скорости обработки таблицу лучше представить в виде одного столбца), сохраняем книгу в формате *.xlsm, после чего приступаем к созданию макроса.

Через меню «Разработчик» открываем встроенный VBA редактор и начинаем творить.

Sub job_sql()  — Пусть наш макрос называется job_sql.

Пропишем переменные для подключения к БД, записи данных и запроса:

Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sql As String

Опишем параметры подключения:

sql = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Data Source=Storoge.company.ru Storoge."

Объявим процедуру свойства, для присвоения значения:

Set cn = New ADODB.Connection
    cn.Provider = " SQLOLEDB.1"
    cn.ConnectionString = sql
    cn.ConnectionTimeout = 0
    cn.Open

Вот теперь можно приступать непосредственно к делу.

Организуем цикл:

For i = 2 To 1000

Как вы уже поняли конечное значение i=1000 здесь только для примера, а в реальности конечное значение соответствует количеству строк в Вашей таблице. В целях унификации можно использовать автоматический способ подсчета количества строк, например, вот такую конструкцию:

Dim LastRow As Long
LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count

Тогда открытие цикла будет выглядеть так:

For i = 2 To LastRow

Как я уже говорил выше MS Excel является мощным инструментом для аналитики, и возможности Excel VBA не заканчиваются на простом переборе значений или комбинаций значений. При наличии известных Вам закономерностей можно ограничить объем выгружаемой из БД информации путем добавления в макрос простых условий, например:

If Cells(i, 2) = "Ваше условие" Then

Итак, мы определились с объемом и условиями выборки, организовали подключение к БД и готовы формировать запрос. Предположим, что нам нужно получить информацию о размере ежемесячного платежа [Ежемесячный платеж] из таблицы [PAYMENTS].[refinans_credit], но только по тем случаям, когда размер ежемесячного платежа больше 0

sql = "select [Ежемесячный платеж] from [PAYMENTS].[refinans_credit] " & _
"where [Ежемесячный платеж]>0 and [Номер заявки] ='" & Cells(i, 1) & "' "

Если значений для формирования запроса несколько, соответственно прописываем их в запросе:

"where [Ежемесячный платеж]>0 and [Номер заявки] = '" & Cells(i, 1) & "' " & _
" and [Дата платежа]='" & Cells(i, 2) & "'"

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

Cells(i, 3) = sql

в третьем столбце записываются запросы.

Выполняем SQL запрос:

Set rs = cn.Execute(sql)

А чтобы хоть как-то наблюдать за выполнением макроса выведем изменение i в статус-бар

Application.StatusBar = "Execute script ..." & i
Application.ScreenUpdating = False

Теперь нам нужно записать полученные результаты. Для этого будем использовать оператор Do While:

j = 0
Do While Not rs.EOF
For ii = 0 To rs.Fields.Count - 1
Cells(i, 4 + j + ii) = rs.Fields(0 + ii) '& ";"

Указываем ячейки для вставки полученных данных (4 в примере это номер столбца с которого начинаем запись результатов)

Next ii
j = j + rs.Fields.Count
s.MoveNext
Loop
rs.Close
End If

— закрываем цикл If, если вводили дополнительные условия

Next i
cn.Close
Application.StatusBar = "Готово"
End Sub

— закрываем макрос.

В дополнение хочу отметить, что данный макрос позволяет обращаться как к БД на MS SQL так и к БД Oracle, разница будет только в параметрах подключения и собственно в синтаксисе SQL запроса.

В приведенном примере для авторизации при подключении к БД используется доменная аутентификация.

А как быть если для аутентификации необходимо ввести логин и пароль? Ничего невозможного нет. Изменим часть макроса, которая отвечает за подключение к БД следующим образом:

sql = "Provider= SQLOLEDB.1;Password=********;User ID=********;Data Source= Storoge.company.ru Storoge;APP=SFM"

Но в этом случае при использовании макроса возникает риск компрометации Ваших учетных данных. Поэтому лучше программно удалять учетные данные после выполнения макроса. Разместим поля для ввода пароля и логина на листе и изменим макрос следующим образом:

sql = "Provider= SQLOLEDB.1;Password=" & Sheets("Лист аутентификации").TextBox1.Value & ";User ID=" & Sheets("Лист аутентификации ").TextBox2.Value & ";Data Source= Storoge.company.ru Storoge;APP=SFM"

Место для расположения текстовых полей не принципиально, можно расположить их на листе с таблицей в первых строках, но мне удобней размещать поля на отдельном листе. Чтобы введенные учетные данные не сохранялись вместе с результатом выполнения макроса в конце исполняемого кода дописываем:

Sheets("Выгрузка").TextBox1.Value = ""
Sheets("Выгрузка").TextBox2.Value = ""

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

Вот такое вполне жизнеспособное решение, позволяющее сократить трудозатраты при получении и обработке данных, я использую. Надеюсь мой опыт применения SQL запросов в Excel будет полезен и вам в решении текущих задач.

Источник

Понравилась статья? Поделить с друзьями:
  • Макрос по умолчанию excel
  • Макрос обновления книги excel
  • Макрос номер ячейки excel
  • Макрос начать запись excel
  • Макрос названия листов в книге excel