my_report.Worksheets(1).Range(cl).CopyFromRecordset rs
если цикл из одного такта - то проходит все нормально, если больше то ругается на строке открытия рекордсета: 3709, невозможно использование подключения для выполнения операции. Оно закрыто или не допускается в данном контексте.
Если закоментировать строку с CopyFromRecordset, цикл проходит нормально и наборы(рекордсеты) открываются и закрываются нормально.
Где грабли?
- Код: Выделить всё
Dim excell As Object
Dim my_report As Excel.Workbook
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
путь = App.Path
connect_str = "Data Source=" + путь + "\5min.mdb"
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
With cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = connect_str
.Open
End With
With rs
.ActiveConnection = cn
.CursorType = adOpenStatic
.CursorLocation = adUseClient
.LockType = adLockOptimistic
End With
Set excell = CreateObject("Excel.Application")
Set my_report = excell.Workbooks.Add
'excell.Visible = False 'видно или не видно excel в панели задач
my_report.Worksheets(1).Cells(1, 1) = Format(DTPicker1.Value, "dd mmmm yyyy")
my_report.Worksheets(1).Cells(2, 1) = "период"
For i = 1 To ListView1.ListItems.Count
If ListView1.ListItems(i).Checked = True Then
запрос = "select my_value*0.001 from mosh where my_date='" + CStr(DTPicker1.Value) + "' and id=" + ListView1.ListItems(i).SubItems(1)
rs.Open запрос
'my_report.Worksheets(1).Cells(2, 2) = запрос
cl = "b" & i
my_report.Worksheets(1).Range(cl).CopyFromRecordset rs
'dd = rs.RecordCount
rs.Close
End If
Next i
