Excel VBA. SQL-запросы в подключениях

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

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

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

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

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

[code language=»vb»]
Sub Макрос1()
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
"ODBC;DSN=Excel Files;DBQ=D:\Dropbox\Excel\тест excel_SQL-2015.xlsx;DefaultDir=D:\Dropbox\Excel;DriverId=1046;MaxBufferSize=2048;Page" _
), Array("Timeout=5;")), Destination:=Range("$A$1")).QueryTable
.CommandType = 0
.CommandText = Array( _
"SELECT Продажи.F2, Продажи.F3" & Chr(13) & "FROM `D:\Dropbox\Excel\тест 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
[/code]

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

[code language=»vb»]
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
[/code]

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

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

[code language=»sql»]
SELECT ‘YTikhonov’, *
FROM [Sheet1$]
[/code]

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

[code language=»sql»]
SELECT [Advertiser] AS ‘Рекламодатель’, [Quantity] AS ‘Количество’
FROM [Sheet1$]
[/code]

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

[code language=»sql»]
SELECT *
FROM [Sheet1$]
WHERE [Year] = 2014
[/code]

Сортировка

[code language=»sql»]
SELECT *
FROM [Sheet1$]
ORDER BY [Advertiser] DESC
[/code]

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

[code language=»sql»]
SELECT [Advertiser], Sum([Cost])
FROM [Sheet1$]
GROUP BY [Advertiser]
[/code]

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

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

[code language=»sql»]
[SomeDateField] = {ts ‘2015-01-01 00:00:00’}
[/code]

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

[code language=»sql»]
SELECT CONVERT(date,SYSDATETIME())
[/code]

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

[code language=»sql»]
DATEADD(minute, 59, DATEADD(hour, 23, DATEADD(month, MONTH(SYSDATETIME())+1, DATEADD(year, YEAR(SYSDATETIME()) — 1900, 0))))-1
[/code]

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

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

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

[code language=»sql»]
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:\GK\Radio\Маркетинг\Служебный\2013.xlsb].[Мониторинг$]
UNION
SELECT Advertiser, 2014 as [Year], Month, [Cost RUB], Quantity, Volume
FROM [N:\GK\Radio\Маркетинг\Служебный\2014.xlsb].[Мониторинг$]
UNION
SELECT Advertiser, 2015 as [Year], Month, [Cost RUB], Quantity, Volume
FROM [N:\GK\Radio\Маркетинг\Служебный\2015.xlsb].[Мониторинг$]
)
WHERE [Advertiser] = ‘METRO GROUP’
GROUP BY [Year], Month
) as T INNER JOIN [C:\test\Month.xlsb].[Test$] AS O
ON T.[Month] = O.[Month]
[/code]

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

Бонусы

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

[code language=»vb»]
‘работа с буфером обмена 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
[/code]

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

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

[code language=»vb»]
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
[/code]

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/

 

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