не могу забороть проблему.... может кто сталкивался
значит, на VB есть некое GUI приложение и activeX DLL
эта ДЛЛ возвращает отсоединенный иерархический рекордсет
Public Function GetShapeRS(ByVal strsid As String) As ADODB.Recordset
Dim strshape As String
Dim rsTmp As New ADODB.Recordset
strshape = "SHAPE {SELECT ..... до хрена всего
With rsTmp
' connection CNN уже создан и открыт другой функцией этой же ДЛЛ
Set .ActiveConnection = cnn
.CursorLocation = adUseClient
.CursorType = adOpenStatic
.LockType = adLockBatchOptimistic
.Source = strshape
.Open options:=adCmdText
Set .ActiveConnection = Nothing
End With
Set GetShapeRSbyCell = rsTmp
Set rsTmp = Nothing
End Function
проблема в том что на принимающей стороне , где
dim rs as ADODB.Recordset
rs = GetShapeRS(str)
у рекорсета теряется .source и как следствие после обновления рекордсета другой функцией из ДЛЛ
его надо бы обновить но 1. метод recordset.requery не работает (баг в ADO) — после .updatebatch у рекордсета устанавливается
св-во locked поэтому большой брат рекомендует переоткрыть через .close .open но открытие дает ошибку ибо нет .source
Public Sub UpdateShapeRS(ByVal rsTmp As ADODB.Recordset)
Dim tmpCnn As ADODB.Connection
Dim rst1 As ADODB.Recordset
Dim rst2 As ADODB.Recordset
Set tmpCnn = New ADODB.Connection
With tmpCnn
.Provider = "MSDataShape.1"
.Open "Data Source=" & strDataBaseName & ";Data Provider=Microsoft.Jet.OLEDB.4.0"
End With
With rsTmp
Set .ActiveConnection = tmpCnn
.MoveFirst
Do While Not .EOF
.Update
Set rst1 = .Fields("cell_texts").Value
Do While Not rst1.EOF
rst1.Update
Set rst2 = rst1.Fields("inter_cells").Value
Do While Not rst2.EOF
'rst2.Fields("Updated").Value = True
rst2.Update
rst2.MoveNext
Loop
rst2.UpdateBatch
rst1.MoveNext
Loop
rst1.UpdateBatch
.MoveNext
Loop
.UpdateBatch
Set rst2 = Nothing
Set rst1 = Nothing
.Close
.Open
Set .ActiveConnection = Nothing
End With
End If
End Sub
