Hi guys,
i am not new to vb6, but a mere tyro in vb.net what i want to do is
the following
open transaction
build an ADODB command object using parameters
execute it
build another command
execute it
build another command
execute it
if all is well commit, else rollback.
my problem is that on the third execute, it dies with the above error.
this error seems to be comming out of cmd.activeconnection.errors
collection. this odd because the connection object and the command
object both show open and in a legitimate state. the collection also
appears to have the right values
any and all help desperately needed. pls don't say use ado.net unless
you are prepared to post equivalent code.
all code is as follows:
** FIRST **
Private Function Add() As Boolean
Dim cmd As ADODB.Command
Dim u As New cUtilites
Dim cn As ADODB.Connection
cn = mdiMain.gDB.Conn
Try
FieldValue("ClientID") = GetNewClientID()
cmd = u.BuildCommand("APP001_InsertEMCApps", RecCol(1))
cn.BeginTrans()
If mdiMain.gDB.Execute(cmd, cn) Then ** OK **
'append names
If Me.Names.Save(FieldValue("clientid"), cn) Then
cn.CommitTrans()
Else
cn.RollbackTrans()
End If
Else
cn.RollbackTrans()
End If
Catch ex As Exception
cn.RollbackTrans()
End Try
cmd = Nothing
u = Nothing
End Function
** SECOND **
Private Function Add(ByVal flds As Collection, Optional ByRef cn As
ADODB.Connection = Nothing) As Boolean
Dim cmd As ADODB.Command
Dim u As New cUtilites
cmd = u.BuildCommand("APP003_InsertEMCNames", flds)
If Not IsNothing(cmd) Then
Add = mdiMain.gDB.Execute(cmd, cn)
Else
Add = False
End If
u = Nothing
End Function
Public Function Save(ByVal ClientID As String, Optional ByRef cn
As ADODB.Connection = Nothing) As Boolean
Dim flds As Collection
If FieldValue("contid", "C") = "" Then
FieldValue("clientid", "C") = ClientID
Save = Add(NamesCol("C"), cn) ** OK **
Else
Update()
End If
If FieldValue("contid", "A") = "" Then
FieldValue("clientid", "A") = ClientID
Save = Add(NamesCol("A"), cn) ** ERROR HERE **
Else
Update()
End If
flds = Nothing
End Function
** THIRD ****
Public Function Execute(ByRef cmd As ADODB.Command, Optional ByRef cn
As ADODB.Connection = Nothing) As Boolean
On Error Resume Next
'very old copied vb6 code
Dim lRecordsAffected As Long
'open connection if ConnectionTo is nothing
With cmd
If cn Is Nothing Then
.ActiveConnection = mCN
Else
.ActiveConnection = cn
End If
.CommandTimeout = 600
.Execute(lRecordsAffected)
End With
With cmd.ActiveConnection ** ERROR HERE AFTER 3RD EXECUTE
**
'put the native error in the errors collection
If .Errors.Count > 0 Then
Err.Raise(.Errors(0).NativeError, .Errors(0).Source,
..Errors(0).Description)
End With
'try catch throw finally
If Err.Number = 0 Then
Execute = True
Else
Execute = False
MsgBox("Error in cDataServices.Execute(). " & Err.Number &
" " & Err.Source & " " & Err.Description)
Err.Clear()
End If
cmd = Nothing
End Function
'builds the command object
Public Function BuildCommand(ByVal SPname As String, ByVal fldCol As
Collection) As ADODB.Command
Dim strSql As String 'SQL string for Error
information
Dim strParams As String 'Param No for Error
information
Dim strNote As String 'Extra error info
Dim cmd As ADODB.Command
Dim FldLen As Integer
cmd = New ADODB.Command
Try
With cmd
.CommandType = ADODB.CommandTypeEnum.adCmdStoredProc
.CommandText = SPname
'Store all parameter and their values in a string for
error reporting
strParams = "Parameters passed to the SP " & SPname &
" are:"
'Following loop sets all the parameters
For Each fld As PType In fldCol
'Set the parameter for the prepared statement
Select Case fld.Datatype
Case ADODB.DataTypeEnum.adChar,
ADODB.DataTypeEnum.adVarChar
FldLen = IIf(Len(fld.varValue) = 0, 1,
Len(fld.varValue))
Case Else
FldLen = fld.intLen
End Select
'debug
fld.varValue = YesNull(fld.varValue)
strParams = strParams & vbCrLf & "Name = " &
fld.FieldName & " Value = " & fld.varValue
.Parameters.Append(.CreateParameter(fld.FieldName,
fld.Datatype, ADODB.ParameterDirectionEnum.adParamInput, FldLen,
fld.varValue))
Next fld 'End of for loop
End With
Catch e As Exception
cmd = Nothing
MsgBox("build command " & e.Message)
End Try
Return cmd
End Function
