ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / не могу скопировать рекордсет в PivotCache
4 сообщений из 4, страница 1 из 1
не могу скопировать рекордсет в PivotCache
    #35146547
detail
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
detail
Участник
Вот такая функция у меня сделана в Access-e 2003. После некоторых изменений перестала работать, начала ругаться на строку
Set xlBook.PivotCaches(i + 1).Recordset = rs (рекордсет копируется в pivotcache)

Runtime error 1004: Application-defined or object-defined error

Я проверил rs и pivotcaches(i + 1) - всё с ними в порядке, т.е. запрос отработал нормально и вернул набор данных, кэши есть. Тип данных rs раньше был тем же самым (ADODB.Recordset). Не понимаю, в чём дело.
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
Function exportToExcelPivot(ByVal templateFileName As String, ByVal queries As Variant, _
Optional ByVal targetFileName As String = "", Optional ByVal params As Variant) As Variant

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim objPivotCache As Excel.PivotCache

Dim comm As ADODB.Command
Dim rs As New ADODB.Recordset

Set xlApp = CreateObject("Excel.Application") 'Ñîçäàíèå îáúåêòà MSExcel
Set xlBook = xlApp.Workbooks.Open(templateFileName)
'xlApp.Visible = True 'Âûâîäèì íà ýêðàí (îñòàâëåíî äëÿ âîçìîæíîé îòëàäêè)
xlApp.DisplayAlerts = False 'Çàïðåò âîçìîæíûõ ñîîáùåíèé MSExcel


Dim i As Integer
For i =  0  To UBound(queries)

    Set comm = New ADODB.Command
    Set comm.ActiveConnection = CurrentProject.Connection
    comm.CommandType = adCmdStoredProc
    
    For j =  0  To UBound(params)
        comm.Parameters.Append comm.CreateParameter(params(j)( 0 ), _
        adChar, adParamInput,  3 , params(j)( 1 ))
    Next j

    rs.CursorLocation = adUseClient 'Ðåêîðäñåò áóäåò ñîçäàí ó êëèåíòà
    comm.CommandText = queries(i)
    
    Set rs = comm.Execute
    Set xlBook.PivotCaches(i +  1 ).Recordset = rs
    xlBook.PivotCaches(i +  1 ).Refresh
    
    rs.Close
    
    Set comm = Nothing
    Set rs = Nothing '×èñòèì ïàìÿòü îò îáúåêòà
Next i

Debug.Print targetFileName

If targetFileName = "" Then
    xlApp.DisplayAlerts = True 'Ðàçðåøàåì ñîîáùåíèÿ MSExcel
    xlApp.Visible = True 'Âûâîäèì íà ýêðàí
    Set exportToExcelPivot = xlBook
    Exit Function
End If

xlBook.SaveAs fileName:=targetFileName, _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
    ReadOnlyRecommended:=False, CreateBackup:=False
    
xlApp.Quit

Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
    
End Function
...
Рейтинг: 0 / 0
21.02.2008, 10:54
| Ответить | Цитировать | Написать  
не могу скопировать рекордсет в PivotCache
    #35147630
detail
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
detail
Участник
Методом тыка нашёл и исправил проблему. Мой рекордсет (т.е. тот, что создан из запроса) должен был быть открытым командой open и клонирован.

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
Function exportToExcelPivot(ByVal templateFileName As String, ByVal queries As Variant, Optional ByVal targetFileName As String = "", Optional ByVal params As Variant) As Variant

Dim i As Integer, j As Integer
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim objPivotCache As Excel.PivotCache

Dim comm As ADODB.Command
Dim rs As New ADODB.Recordset

Set xlApp = CreateObject("Excel.Application") 'Создание объекта MSExcel
Set xlBook = xlApp.Workbooks.Open(templateFileName)
xlApp.Visible = True 'Выводим на экран (оставлено для возможной отладки)
xlApp.DisplayAlerts = False 'Запрет возможных сообщений MSExcel

For i =  0  To UBound(queries)

        Set comm = New ADODB.Command
        Set comm.ActiveConnection = CurrentProject.Connection
        comm.CommandType = adCmdStoredProc

        For j =  0  To UBound(params)
                comm.Parameters.Append comm.CreateParameter(params(j)( 0 ), _
                adChar, adParamInput,  3 , params(j)( 1 ))
        Next j

        comm.CommandText = "exec [" & queries(i) & "]"
        rs.CursorLocation = adUseClient 'Рекордсет будет создан у клиента

        rs.Open comm, , adOpenStatic, adLockReadOnly, adCmdText
        Set xlBook.PivotCaches(i +  1 ).Recordset = rs.Clone
        xlBook.PivotCaches(i +  1 ).Refresh
        rs.Close

        Set comm = Nothing
        Set rs = Nothing 'Чистим память от объекта
Next i

Debug.Print targetFileName

If targetFileName = "" Then
        xlApp.DisplayAlerts = True 'Разрешаем сообщения MSExcel
        xlApp.Visible = True 'Выводим на экран
        Set exportToExcelPivot = xlBook
        Exit Function
End If

xlBook.SaveAs fileName:=targetFileName, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False

xlApp.Quit

Set xlSheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing

End Function
...
Рейтинг: 0 / 0
21.02.2008, 14:23
| Ответить | Цитировать | Написать  
не могу скопировать рекордсет в PivotCache
    #35519335
loaneo
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
loaneo
Гость
у меня эта проблема так и не решилась. Может что с кодом не так?
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
Public Sub DynamicOfWorkInProgress(StartDate As String, EndDate As String, Interval As Byte, StrukturaIDIsp As Integer, StrukturaIDZakaz As Integer, StatyaID As Integer)
    Dim cmd As ADODB.Command
    Dim conn As ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim param As ADODB.Parameter
    Dim oExcel As New Excel.Application
    Dim oBook As Excel.Workbook
    Dim oSheet As Excel.Worksheet
    Dim oPivotCache As Excel.PivotCache
    Dim oPivotTable As Excel.PivotTable
    
    Set oBook = oExcel.Workbooks.Add(xlWBATWorksheet)
    Set oSheet = oExcel.ActiveSheet
    
    Set conn = New ADODB.Connection
    conn.Open myConnStr
    
    Set cmd = New ADODB.Command
    cmd.ActiveConnection = conn
    cmd.CommandText = "EXEC    [dbo].[DynamicOfWorkInProgess] @StartDate =N'" & _
    StartDate & "', @EndDate = N'" & EndDate & _
    "', @Interval = " & Interval & ", @StrukturaIDIsp = " & _
    StrukturaIDIsp & ", @StrukturaIDZakaz = " & StrukturaIDZakaz & _
    ", @StatyaID = " & StatyaID
    cmd.CommandType = adCmdStoredProc
    cmd.NamedParameters = True
    cmd.CommandTimeout =  0 
'    Set param = New ADODB.Parameter
'
'    Set param = cmd.CreateParameter("@StartDate", adDBTime, adParamInput, , StartDate)
'    cmd.Parameters.Append param
'    Set param = cmd.CreateParameter("@EndDate", adDBTime, adParamInput, , EndDate)
'    cmd.Parameters.Append param
'    Set param = cmd.CreateParameter("@Interval", adTinyInt, adParamInput, , Interval)
'    cmd.Parameters.Append param
'    Set param = cmd.CreateParameter("@StrukturaIDIsp", adInteger, adParamInput, , StrukturaIDIsp)
'    cmd.Parameters.Append param
'    Set param = cmd.CreateParameter("@StrukturaIDZakaz", adInteger, adParamInput, , StrukturaIDZakaz)
'    cmd.Parameters.Append param
'    Set param = cmd.CreateParameter("@StatyaID", adInteger, adParamInput, , StatyaID)
'    cmd.Parameters.Append param
    
    rs.CursorLocation = adUseClient
    rs.Open cmd, , adOpenStatic, adLockReadOnly, adCmdText
    oExcel.Visible = True
    Set oPivotCache = oBook.PivotCaches.Add(xlExternal)
    With oPivotCache
        .Recordset = rs
        .CreatePivotTable TableDestination:=oSheet.Range("A5"), TableName:="Dynamic"
    End With
    
    
End Sub

Public Sub Main()
    DynamicOfWorkInProgress Format("01-01-2008", "yyyy-mm-dd hh:nn:ss"), Format("04-01-2008", "yyyy-mm-dd hh:nn:ss"),  1 ,  0 ,  0 ,  0 
End Sub
...
Рейтинг: 0 / 0
03.09.2008, 07:17
| Ответить | Цитировать | Написать  
не могу скопировать рекордсет в PivotCache
    #35519638
Фотография Игорь Горбонос
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Игорь Горбонос
Участник
> Автор: loaneo
> у меня эта проблема так и не решилась. Может что с кодом не так?


Попробуй сделать рекордсет средствами екселя, несмотря на нахождение в акцесе

--
С уважением Горбонос Игорь Леонидович

Posted via ActualForum NNTP Server 1.4
...
Рейтинг: 0 / 0
03.09.2008, 10:45
| Ответить | Цитировать | Написать  
4 сообщений из 4, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / не могу скопировать рекордсет в PivotCache
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=60&gotonew=1&tid=2161898]:
 0ms
get settings:
 10ms
get forum list:
 15ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 44ms
get topic data:
 7ms
get first new msg:
 4ms
get forum data:
 2ms
get page messages:
 25ms
get tp. blocked users:
 1ms
others: 231ms
total:  345ms
созд. / загр.: 345ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]