Как подключиться к БД используя VBA Excel 2003
Модераторы: m0p3e, edward_K, Модераторы
-
- Посетитель
- Сообщения: 33
- Зарегистрирован: 20 сен 2007, 11:43
- Откуда: Беларусь
- Контактная информация:
Как подключиться к БД используя VBA Excel 2003
Здравствуйте! Такой вопрос. Из Галактики 7.11 конвертировал в Excel отчет, но с БД необходимо вытащить некоторые значения. Как написать запрос к БД используя макрос?
-
- Местный житель
- Сообщения: 222
- Зарегистрирован: 04 июн 2008, 14:35
- Откуда: Стерлитамак
- Контактная информация:
Код: Выделить всё
Sub GetData()
'
' GetData Макрос
' Выгрузка из Галактики (*)
'
' Сочетание клавиш: Ctrl+g
'
Dim strSQLstmt As String
strSQLstmt = "select " & _
"from " & _
" build.dbo.[t$katsopr] katsopr " & _
"where " & _
" katsopr.[f$DSOPR] >= dbo.ToAtlDate(convert(datetime,'" & Range("E3").Value & "',104)) and katsopr.[f$DSOPR] <= dbo.ToAtlDate(convert(datetime,'" & Range("F3").Value & "',104)) " & _
" and katsopr.f$tipsopr = 2 " & _
Range("B6:Y65000").Clear
With ActiveSheet.QueryTables.Add(Connection:= _
"ODBC;DSN=Build;APP=Microsoft Office;WSID=PROGSECT;DATABASE=Build;Trusted_Connection=Yes" _
, Destination:=Range("B6"))
.CommandText = strSQLstmt
.Name = "Build"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = False
.Refresh BackgroundQuery:=False
End With
End Sub
Тоже простой пример:
Код: Выделить всё
Private Sub btnExec_Click()
Const brow = 6
Const bcol = 1
Dim cngal As New ADODB.Connection
Dim cdgal As New ADODB.Command
Dim rsgal As New ADODB.Recordset
Dim constr As String
Dim sqlstr As String
constr = "server=GalServ;Database=GalBase;trusted_connection=yes"
' Получение данных с помощью перекрестного запроса
sqlstr = "текст запроса или вызов хранимой процедуры"
' Подключение к серверу
cngal.Provider = "sqloledb"
cngal.CommandTimeout = 0
cngal.ConnectionTimeout = 0
cngal.Open constr
' Получение данных из Галактики
Set cdgal.ActiveConnection = cngal
cdgal.CommandText = sqlstr
cdgal.CommandTimeout = 0
rsgal.MaxRecords = 0
rsgal.CursorType = adOpenStatic
rsgal.LockType = adLockReadOnly
Set rsgal = cdgal.Execute
' Вывод данных основного запроса
Cells(brow, bcol).CopyFromRecordset rsgal
' Завершаем соединение
rsgal.Close
cngal.Close
Set rsgal = Nothing
Set cngal = Nothing
Application.ActiveWorkbook.Save
End Sub