Dim Cn() As ADODB.Connection
Private Sub Command1_Click()
Static cnt As Long
cnt = cnt + 1
ReDim Preserve Cn(cnt)
Set Cn(cnt) = New ADODB.Connection
Cn(cnt).ConnectionString = "mystring"
Cn(cnt).Open
Cn(cnt).Execute "truncate table trace", , 16
cnt = cnt + 1
ReDim Preserve Cn(cnt)
Set Cn(cnt) = New ADODB.Connection
Cn(cnt).ConnectionString = "mystring"
Cn(cnt).Open
Cn(cnt).Execute "truncate table trace", , 16
End Sub
Dim WithEvents CN As ADODB.Connection
Dim WithEvents RS As ADODB.Recordset
Private Sub CN_ConnectComplete(ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pConnection As ADODB.Connection)
RS.ActiveConnection = CN
End Sub
Private Sub Command1_Click()
Set CN = New ADODB.Connection
Set RS = New ADODB.Recordset
CN.ConnectionString = "Provider=OraOLEDB.Oracle.1;Persist Security " & _
"Info=False;User ID=us; PASSwORD=pass; Data Source=source"
CN.Open
RS.Open "select field1, sum(field2) from mytable group by field1", , , , 16
RS.MoveFirst
End Sub
Private Sub rs_FetchComplete(ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
bComplete = True
'ЗДЕСЬ!!!
End Sub
Private Sub rs_FetchProgress(ByVal Progress As Long, ByVal MaxProgress As Long, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
Me.lblRecordCount.Caption = "Найдено записей: " & Me.rs.RecordCount
End Sub
Dim WithEvents CN As ADODB.Connection
Dim WithEvents RS As ADODB.Recordset
Private Sub CN_ConnectComplete(ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pConnection As ADODB.Connection)
RS.Open "select field1, sum(field2) from mytable group by field1", cn, , , 16
End Sub
Private Sub Command1_Click()
Set CN = New ADODB.Connection
Set RS = New ADODB.Recordset
CN.ConnectionString = "Provider=OraOLEDB.Oracle.1;Persist Security " & _
"Info=False;User ID=us; PASSwORD=pass; Data Source=source"
CN.Open
End Sub
Private Sub RS_FetchComplete(pError As Error, adStatus As EventStatusEnum, pRecordset As Recordset)
RS.MoveFirst
End Sub
Set cn = New ADODB.Connection
cn.CommandTimeout = 0
cn.ConnectionTimeout = 30
cn.CursorLocation = adUseClient
cn.Open modADO.GetConnectionString
Set rsEvents = New ADODB.Recordset
rsEvents.CursorLocation = adUseClient
rsEvents.PageSize = 100
rsEvents.CacheSize = 1000
Set rsEvents.ActiveConnection = cn
rsEvents.Open SQL, , adOpenStatic, adLockReadOnly, adAsyncFetchNonBlocking
Me.lblRecordCount.Caption = "Найдено записей: " & rsEvents.RecordCount
Set dtgEvents.DataSource = rsEvents
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim CNR() As ADODB.Connection
Dim WithEvents CN As ADODB.Connection
Dim WithEvents RS As ADODB.Recordset
Dim Cstring as String
Private Sub CN_ConnectComplete(ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pConnection As ADODB.Connection)
RS.ActiveConnection=CN
End Sub
Private Sub Command1_Click()
'АСИНХРОННО ЗАПУСКАЮ ПРОЦУ:
Set CNR(0) = New ADODB.Connection
Cstring="Provider=OraOLEDB.Oracle.1;Persist Security " & _
"Info=False;User ID=us; PASSwORD=pass; Data Source=source"
CNR(0).Open Cstring
CNR.Execute "myprocedure",, adAsyncExecute
'ДАЛЕЕ СМОТРЮ КАК ОНА ВЫПОЛНЯЕТСЯ:
Set CN= New ADODB.Connection
Set RS= New ADODB.Recordset
CN.Open Cstring
cnt=1
While cnt<>0
RS.Open "select count(*) cnt from mytable where dt_obr is null"
if not RS.EOF then
RS.MoveFirst
cnt=RS.Fields("cnt").value
else
cnt=0 'необработанных записей не осталось, выходим из цикла
end if
RS.Close
DoEvents
Sleep 5000
Wend
End Sub
Private Sub RS_FetchComplete(pError As Error, adStatus As EventStatusEnum, pRecordset As Recordset)
RS.MoveFirst
End Sub
Этот цикл блокирует прогу, а если ты им всего лишь ждешь результата выполнения myprocedure, то нафига тогда асинхронность?
А знаешь, чем тебе грозит DoEvents в цикле?
Сейчас этот форум просматривают: AhrefsBot, SemrushBot, Yandex-бот и гости: 29