Ok, here it goes...
Below is the data access code I mentioned. I know this may be rather lengthy, but in the
interest of brevity and confidentiality, I've modified some of the variable and object
names and omitted things like the creation of the ParamArray from vntParams.
The logic, however, is the same.
The
RunSPInTransReturnLong is listed below as well.
The
CtxCreateObject function creates (and returns) an MTS ObjectContext object.
GetConnectionString should be obvious. Let me know if I need to provide any further info.
CtxRaiseError calls SetAbort and then raises the error to the calling object.
Also, the CtxCreateObject and CtxRaiseError functions are in a .bas module.
Public Function Save(vntMParams() As Variant, vntEq() As Variant) As Long
On Error GoTo SaveErr:
Dim lngMReturnVal As Long, lngID As Long
Dim blnMPersistSuccessful As Boolean, blnEQPersistSuccessful As Boolean
' Declare variable for the Command object
Dim cmdCommand As ADODB.Command
' Create the ADO Command object
Set cmdCommand =
CtxCreateObject("ADODB.Command"
'Initialize Persist success flag
blnMPersistSuccessful = False
'Open the Command object's connection and start the transaction
cmdCommand.ActiveConnection =
GetConnectionString()
cmdCommand.ActiveConnection.BeginTrans
If vntMParams(15) = True Then
'Adding
lngMReturnVal =
RunSPInTransReturnLong(cmdCommand, "InsertSP", <
ParamArray from vntMParams here>)
'Set Persist success flag based on return value from store procedure
'A return value of zero here is a failure
blnMPersistSuccessful = (lngMReturnVal > 0)
Else
'Updating
lngMReturnVal =
RunSPInTransReturnLong(cmdCommand, "UpdateSP", <
ParamArray from vntMParams here>)
'Set Persist success flag based on return value from store procedure
'A return value of zero here is a success
blnMPersistSuccessful = (lngMReturnVal = 0)
End If
'If save was unsuccessful, rollback transaction, clean up, and exit
If Not blnMPersistSuccessful Then
Save = lngMReturnVal
cmdCommand.ActiveConnection.RollbackTrans
Set cmdCommand.ActiveConnection = Nothing
Set cmdCommand = Nothing
Exit Function
End If
'If saving a new one, get the ID from the return value of the
'stored procedure call. Otherwise, use the one passed in inside the array.
If vntMParams(15) = True Then
lngID = lngMReturnVal
Else
lngID = vntMParams(23)
End If
If UBound(vntEq, 2) = 0 Then
'No Eq's exist (this is the most likely case)
'Force persist flag to True if there are no Eqs so that the transaction
'can still be committed if the M was persisted successfully
blnEQPersistSuccessful = True
Else
'Eq's exist, save and/or delete them accordingly.
Dim lngIndex As Long, lngEqReturnVal As Long
Set mobjEqPersist =
CtxCreateObject("DATAACCESS.EqPersist"
'Cycle through Eq array
For lngIndex = 0 To UBound(vntEq)
blnEQPersistSuccessful = False
Select Case UCase(vntEq(lngIndex, 1))
Case "SAVE"
Dim vntSaveArray(2) As Variant
vntSaveArray(0) = lngID
vntSaveArray(1) = vntEq(lngIndex, 0)
'Call stored procedure to save
lngEqReturnVal = mobjEqPersist.Save(cmdCommand, _
vntSaveArray)
'Set Persist success flag based on return value from stored procedure
blnEQPersistSuccessful = (lngEqReturnVal > 0)
Case "DELETE"
Dim vntDeleteArray(2) As Variant
vntDeleteArray(0) = lngID
vntDeleteArray(1) = vntEq(lngIndex, 0)
'Call stored procedure to delete
lngEqReturnVal = mobjEqPersist.Delete(cmdCommand, _
vntDeleteArray)
'Set Persist success flag based on return value from stored procedure
blnEQPersistSuccessful = (lngEqReturnVal = 0)
Case Else
blnEQPersistSuccessful = True
End Select
'Exit the loop if any of the persist activities are unsuccessful
If Not blnEQPersistSuccessful Then
Exit For
End If
Next lngIndex
End If
If blnEQPersistSuccessful Then
'If all Eq persist activities are successful, set return value equal
'to return value from save of M and commit the entire transaction
Save = lngMReturnVal
cmdCommand.ActiveConnection.CommitTrans
Else
If vntMParams(15) = True Then
'Set return value to zero to signify a failure on the
'save of a new M
Save = 0
Else
'Set return value to non-zero to signify a failure on the
'save of a existing M
Save = 1
End If
cmdCommand.ActiveConnection.RollbackTrans
End If
'Cleanup and return
Set cmdCommand.ActiveConnection = Nothing
Set cmdCommand = Nothing
Exit Function
'-------------------------------------------------------------------------------
SaveErr:
Call CtxRaiseError(Err.Number, M_STRMODULENAME & ".Save Method", _
Err.Description)
End Function
________________________________________________________________________________
Public Function RunSPInTransReturnLong(ByRef cmdCommand As ADODB.Command, _
ByVal strSP As String, ParamArray vntParams() As Variant) As Long
On Error GoTo RunSPInTransReturnLongErr:
' Init the ADO Command object
cmdCommand.CommandText = strSP
cmdCommand.CommandType = adCmdStoredProc
'Clear out Parameters collection before loading again
With cmdCommand.Parameters
If .Count > 0 Then
Dim lngIndex As Long
For lngIndex = .Count - 1 To 0 Step -1
.Delete lngIndex
Next
End If
End With
' Append the parameters to the Command object, Parameters collection
CollectParams cmdCommand, vntParams
' Add another parameter as the last parameter. It is outgoing and named @retval
cmdCommand.Parameters.Append _
cmdCommand.CreateParameter("@retval", adInteger, adParamOutput, 4)
' Execute the stored procedure without a resulting recordset and pull out
' the "return value" parameter
cmdCommand.Execute , , ADODB.adExecuteNoRecords
RunSPInTransReturnLong = cmdCommand.Parameters("@retval"

.Value
Exit Function
---
Error handler code...
End Function
WHEW!!! Any help is greatly appreciated.