|
23.04.2012, 17:48
#37766780
Ссылка:
Ссылка на сообщение:
Ссылка с названием темы:
|
|
|
|
|
Подскажите пожалуйста нужно выгрузить в Excel данные из Oracle 90000 строк 40 столбцов (процедура Ref Cursor)
Что я не делал вылетает ошибка недостаточно памяти (вся память и в праду съедается). Код ниже
Ошибка появилась после добавления еще одного поля SubStr(ххх,1,255) пробовал и SubStr(ххх,1,25)
(в VBA я не специалист)
Public Function GetR(rs As Object, n As Long) As Variant
Dim a As Variant
Dim c() As Variant
Dim i, l, k As Long
l = rs.Fields.Count
a = rs.GetRows(n) ' выгрузив 80000 и съев всю память здесь падает
ReDim c(n - 1, l - 1)
For i = 0 To n - 1
For k = 0 To l - 1
c(i, k) = a(k, i)
Next k
Next i
Erase a
Set a = Nothing
GetR = c
Erase c
'Set c = Nothing
End Function
'функция выгрузки
Public Sub ADORun(ByVal FuncOrProcNameWithParams As String, _
ByVal FuncOrProcType As Byte, _
Optional FirstRow As Long = 0, _
Optional FirstCol As Long = 0, _
Optional LastCol As Long = 0)
Dim FuncOrProcCall As String
Dim CurLastRow As Long
Dim a As Variant
Dim n As Long
Dim j As Long
Select Case FuncOrProcType
Case adProc, adProcRetCur
FuncOrProcCall = "{call " + FuncOrProcNameWithParams + "}"
Case adFunc
FuncOrProcCall = "{? = call " + FuncOrProcNameWithParams + "}"
End Select
Command.CommandText = FuncOrProcCall
Command.Prepared = True
Select Case FuncOrProcType
Case adProc
Set ADOExec = Command.Execute()
Case adProcRetCur
Set RecordSet = Command.Execute() 'у меня такая команда
Call ClearRange(FirstRow, FirstCol, LastCol)
'изначально пробовал так
'With ThisWorkbook.ActiveSheet.QueryTables.Add( _
' Connection:=RecordSet, _
' Destination:=Cells(FirstRow, FirstCol))
' .Name = "Data List"
' .FieldNames = False
' .PreserveFormatting = True
' .RefreshStyle = xlOverwriteCells
' .AdjustColumnWidth = False
' .Refresh BackgroundQuery:=True
'End With
'Cells(FirstRow, FirstCol).CopyFromRecordset RecordSet ' потом так
' последний вариант грузить по 10000 строк
If Not RecordSet.EOF Then
'RecordSet.MoveLast
RecordSet.MoveFirst
End If
n = RecordSet.Fields("RowCnt")
If n <= 10000 Then
a = GetR(RecordSet, n) 'RecordSet.RecordCount)
Range(Cells(FirstRow, FirstCol), Cells(UBound(a, 1) + FirstRow, UBound(a, 2) + FirstCol)) = a
Else
For j = 1 To n \ 10000
a = GetR(RecordSet, 10000)
Range(Cells((j - 1) * 10000 + FirstRow, FirstCol), Cells((j - 1) * 10000 + UBound(a, 1) + FirstRow, UBound(a, 2) + FirstCol)) = a
Next j
a = GetR(RecordSet, n Mod 10000)
Range(Cells(n - (n Mod 10000) + FirstRow, FirstCol), Cells(n + FirstRow, UBound(a, 2) + FirstCol)) = a
End If
|
|
|
