Пытаюсь вывести запрос в шаблон excel, по введенному полю Год. В итоге выводит пустые значения, хотя запрос рабочий:
SELECT Otr_organ.Naimenovanie, Uslugi.Naimenovanie, Uslugi.Adm_reglament, SUM(Monitoring.Kol_vo_zayaviteley) AS [Sum-Kol_vo_zayaviteley1], SUM(Monitoring.Kol_vo_predost_uslug) AS [Sum-Kol_vo_predost_uslug], SUM(Monitoring.Vsego_okazano_uslug_el) AS [Sum-Vsego_okazano_uslug_el]
FROM ((Otr_organ INNER JOIN Users ON Otr_organ.ID_otr_organa = Users.ID_user) INNER JOIN Uslugi ON Otr_organ.ID_otr_organa = Uslugi.ID_otr_organ) INNER JOIN Monitoring ON Uslugi.ID_uslugi = Monitoring.ID_uslugi
WHERE (((Users.ID_user)=[Код]) AND ((Monitoring.God)=[Год]))
GROUP BY Otr_organ.Naimenovanie, Uslugi.Naimenovanie, Uslugi.Adm_reglament;
Сам код вывода в excel:
Private Sub Кнопка48_Click()
Dim xlSheet As Excel.Worksheet
Dim wbTarget As Workbook
Dim xlApp As Excel.Application
Dim fileXLT As String, fileXLS As String, strQry As String
Dim rs As ADODB.Recordset
Dim MyQueryTable As Excel.QueryTable
Dim obj As Excel.Range
Dim strMax As String
Dim a As Variant
Dim b As Variant
Dim c As Variant
'Определяем имена шаблона и документа
fileXLT = CurrentProject.Path & "\Мониторинг_год.xltm"
fileXLS = CurrentProject.Path & "\Мониторинг_год.xlsx"
If Dir(fileXLS) <> "" Then
If MsgBox("Документ с таким именем ранее уже был создан. Заменить его?", vbYesNo, "admin") = vbNo Then
'если выбрали нет (не заменять), тогда просто открываем документ
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Workbooks.Open fileXLS
.Visible = True
End With
Set xlApp = Nothing
Else
'если выбрали да - удаляем файл
fDeleteFile (fileXLS)
GoTo lab 'и переходим к созданию нового документа
End If
Else
lab:
'вставляем таблицу из запроса
'в шаблоне пишем в нужном месте метку ZT - с нее начнется вставка данных таблицы
a = Forms!MainForm!Spisok' поле с кодом пользователя
c = Forms!MonitoringExcel!Date_god' поле ввода года
Z = Forms!Invisible_form!plStatus 'Статус
If Z = "Admin" Then' запрос для админа с 1 параметром без выбора отраслевого орагана/кода пользователя
strQry = "SELECT Otr_organ.Naimenovanie, Uslugi.Naimenovanie, Uslugi.Adm_reglament, Sum(Monitoring.Kol_vo_zayaviteley) AS [Sum-Kol_vo_zayaviteley1], Sum(Monitoring.Kol_vo_predost_uslug) AS [Sum-Kol_vo_predost_uslug], Sum(Monitoring.Vsego_okazano_uslug_el) AS [Sum-Vsego_okazano_uslug_el] FROM ((Otr_organ INNER JOIN Users ON Otr_organ.ID_otr_organa = Users.ID_user) INNER JOIN Uslugi ON Otr_organ.ID_otr_organa = Uslugi.ID_otr_organ) INNER JOIN Monitoring ON Uslugi.ID_uslugi = Monitoring.ID_uslugi WHERE (((Monitoring.God) = ('" & с & "'))) GROUP BY Otr_organ.Naimenovanie, Uslugi.Naimenovanie, Uslugi.Adm_reglament;"
Else' запрос с 2 параметрами
strQry = "SELECT Otr_organ.Naimenovanie, Uslugi.Naimenovanie, Uslugi.Adm_reglament, Sum(Monitoring.Kol_vo_zayaviteley) AS [Sum-Kol_vo_zayaviteley1], Sum(Monitoring.Kol_vo_predost_uslug) AS [Sum-Kol_vo_predost_uslug], Sum(Monitoring.Vsego_okazano_uslug_el) AS [Sum-Vsego_okazano_uslug_el] FROM ((Otr_organ INNER JOIN Users ON Otr_organ.ID_otr_organa = Users.ID_user) INNER JOIN Uslugi ON Otr_organ.ID_otr_organa = Uslugi.ID_otr_organ) INNER JOIN Monitoring ON Uslugi.ID_uslugi = Monitoring.ID_uslugi WHERE (((Users.ID_user) = (" & a & ")) And ((Monitoring.God) = ('" & с & "'))) GROUP BY Otr_organ.Naimenovanie, Uslugi.Naimenovanie, Uslugi.Adm_reglament"
End If
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open strQry, CurrentProject.Connection, adOpenStatic, adLockReadOnly, adCmdText
Set xlApp = CreateObject("Excel.Application") 'создаем объект Excel
With xlApp
.Workbooks.Open fileXLT 'Открываем файл
.WindowState = xlMaximized 'разворачиваем во весь экран
.Visible = True 'Отображаем документ
Set xlSheet = .Sheets(1) 'переходим на первый лист
With xlSheet
Set obj = .Cells.Find("ZT") 'ищем ячейку с текстом ZT
If Not obj Is Nothing Then
obj.Activate 'переходим в найденную ячейку - тут будет начало таблицы
obj.Clear 'очищаем ячейку
Set MyQueryTable = .QueryTables.Add(rs, Destination:=obj) 'цепляем данные из запроса
With MyQueryTable
.FieldNames = False
.Refresh 'закачиваем данные
.Application.Run "Test"
End With
xlSheet.Name = Forms!MonitoringExcel!Date_god
Set obj = Nothing
End If
End With
End With
'закрываем рекордсет и пременные
rs.Close
Set rs = Nothing
Set xlSheet = Nothing
Set MyQueryTable = Nothing
Set xlApp = Nothing
If Z = "Admin" Then
Forms!MainForm.Visible = True
DoCmd.Close acForm, "MonitoringExcel"
Else
Forms!Monitoring.Visible = True
DoCmd.Close acForm, "MonitoringExcel"
End If
End If
Exit Sub
Err_:
MsgBox Err.Description 'сообщение об ошибке
Err.Clear
'Закрываем Excel (если открыта объектная переменная)
If Not xlApp Is Nothing Then xlApp.Quit
End Sub
'удаление файла
Function fDeleteFile(strPath As String) As Boolean
On Error GoTo Err_
Dim fs
Set fs = CreateObject("Scripting.FileSystemObject")
fs.DeleteFile strPath
Set fs = Nothing
fDeleteFile = True
Exit Function
Err_:
MsgBox Err.Description, vbCritical, strPath
Err.Clear
fDeleteFile = False
End Function
'вставка данных в заданную ячейку
Function funInsertDate(ByVal Z As String, ByVal strDate As String)
On Error GoTo Err_
Dim obj As Excel.Range
Dim xlApp As Excel.Application
Set xlApp = GetObject(, "Excel.Application")
Set obj = xlApp.ActiveCell.Find(Z) 'ищем ячейку с заданным параметром Z текстом
If Not obj Is Nothing Then
With obj
.Activate 'переходим в найденную ячейку
.FormulaR1C1 = strDate 'вставляем данные
End With
End If
Set obj = Nothing
Set xlApp = Nothing
Exit Function
Err_:
MsgBox Err.Description 'сообщение об ошибке
Err.Clear
End Function
Буквально недавно, до того как я что то сделал неизвестное мне, при запуске вылазила ошибка "method add of object querytables failed" и указывала на эту строчку:
SET MyQueryTable = .QueryTables.ADD(rs, Destination:=obj) 'цепляем данные из запроса
Не знаю что уже и делать, код вывода рабочий... с другим запросом все выводит, а с этим не хочет...
Спасибо
http://www.sql.ru/forum/1159309/vyvod-zaprosa-v-excel