На нашем предприятии несколько десятков удаленных территориально от головного офиса представительств, в каждом из которых имеется база с данными о клиентах каждого представительства. Исторические данные есть и в центральном офисе, но актуальные находятся только в представительстве. Каждая БД на MS SQL Server 2005. Изредка возникает необходимость получить актуальную информацию по всем представительствам в виде таблицы Excel. Например, получить что-то вроде:
select territory, count(customerid) from customer where managerid = 1000До недавнего момента я тупо в MS SQL Server Management Studio менял вручную connect, прогонял скрипт на выборку данных для каждого удаленного офиса и копировал результаты на лист Экселя. Но как-то выдалась свободное время, и я решил автоматизировать процесс сбора данных с удаленных БД, используя старый добрый MS Access.
MS Access имеет такой интересный инструмент, как “Запрос к серверу”, который отправляет sql-инструкцию напрямую серверу базы данных ODBC. Таким образом для любого сервера БД, — SQL Server, Progress OpenEdge, Oracle, — к которому у нас имеется ODBC-драйвер, мы можем создать в Акцессе “Запрос к серверу” на родном для этого сервера диалекте sql.
Таким образом мне осталось в цикле по числу удаленных офисов сменить настройки ODBC-подключения, запустить запрос и вернуть результат в табличку Акцесса. Что для этого было сделано.
Я создал в MS Access табличку с реквизитами подключения для каждого офиса t_ServerList, табличку t0 – приемник результатов запроса для каждого офиса и написал на VBA проход по объекту ADO Recordset для сбора строки ODBC-подключения и “складированию” данных из “Запрос к серверу”с именем queryName в табличку Access t0. В случае возникновения ошибки (не факт, что каждый локальный сервер будет работать во время прогона), в таблицу t_ServerList пишется код ошибки и описание.
Ниже, собственно, сам код:
Option Compare Database
Public Const queryName As String = "q0"
Public Connection As ADODB.Connection, Recordset As ADODB.Recordset
Sub MkPassTruQueryDefSel()
'Руками поменять в свойствах запроса Возврат записей - ДА
'В цикле по таблице серверов t_ServerList создается pass-thtough запрос и данные с выбранного сервера/базы, используя строку запроса strSql
'инсертятся в заранее созданную таблицу акцесс соотв-й корректной структуры
'Таблица с именем t0 должна быть создана заранее
'Пишется дата прохода в таблицу со списком серверов
Dim strSql As String, strCon As String, serverListTableName As String, strServer As String, strDB As String
Dim errAdo As ADODB.Error, strErrAdoMsg As String
Dim qrdef As Dao.QueryDef, db As Dao.Database
'Текст запроса к серверу вбит руками в конструкторе запроса
Set db = CurrentDb
On Error Resume Next
Set qrdef = db.QueryDefs(queryName)
Dim strSQLFillTable As String
strSQLFillTable = "insert into t0 select * from " & queryName 'Запрос на заполнение таблицы очередной порцией
Set Connection = CurrentProject.Connection
Set Recordset = New ADODB.Recordset
serverListTableName = "t_ServerList"
With Recordset
'Каждый проход из рекордсета берутся атрибуты соединения для pass-thtough запроса
'Запрос к исходной таблице со списком серверов
src = "select * from " & serverListTableName & " where use=-1"
.Open src, Connection, adOpenDynamic, adLockOptimistic
.MoveFirst
Do While (.EOF = False)
strServer = .Fields("ip"): strDB = .Fields("DB")
qrdef.Connect = GetTPQConString(strServer, strDB)
CurrentDb.QueryDefs.Refresh
CurrentProject.Connection.Execute strSQLFillTable
.Fields("UseDateTime") = Now 'Запись метки времени использования
.Fields("errNumber") = Err.Number : .Fields("errString") = Err.Description: Err.Clear
.MoveNext
Loop
.Close
End With
Set Recordset = Nothing : Connection.Close : Set Connection = Nothing
Call ShowOkMessage
End Sub
Public Function GetTPQConString(myServerAddress As String, myDataBase As String) As String
'Строка подключения для "запроса к серверу"
GetTPQConString = "ODBC; DRIVER=SQL Server; Server=" & myServerAddress & _
";Database=" & myDataBase & _
";UID=odmin;PWD=pwd;"
End Function
