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.activeconne ction.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.Connectio n
cn = mdiMain.gDB.Con n
Try
FieldValue("Cli entID") = GetNewClientID( )
cmd = u.BuildCommand( "APP001_InsertE MCApps", RecCol(1))
cn.BeginTrans()
If mdiMain.gDB.Exe cute(cmd, cn) Then ** OK **
'append names
If Me.Names.Save(F ieldValue("clie ntid"), cn) Then
cn.CommitTrans( )
Else
cn.RollbackTran s()
End If
Else
cn.RollbackTran s()
End If
Catch ex As Exception
cn.RollbackTran s()
End Try
cmd = Nothing
u = Nothing
End Function
** SECOND **
Private Function Add(ByVal flds As Collection, Optional ByRef cn As
ADODB.Connectio n = Nothing) As Boolean
Dim cmd As ADODB.Command
Dim u As New cUtilites
cmd = u.BuildCommand( "APP003_InsertE MCNames", flds)
If Not IsNothing(cmd) Then
Add = mdiMain.gDB.Exe cute(cmd, cn)
Else
Add = False
End If
u = Nothing
End Function
Public Function Save(ByVal ClientID As String, Optional ByRef cn
As ADODB.Connectio n = Nothing) As Boolean
Dim flds As Collection
If FieldValue("con tid", "C") = "" Then
FieldValue("cli entid", "C") = ClientID
Save = Add(NamesCol("C "), cn) ** OK **
Else
Update()
End If
If FieldValue("con tid", "A") = "" Then
FieldValue("cli entid", "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.Connectio n = Nothing) As Boolean
On Error Resume Next
'very old copied vb6 code
Dim lRecordsAffecte d As Long
'open connection if ConnectionTo is nothing
With cmd
If cn Is Nothing Then
.ActiveConnecti on = mCN
Else
.ActiveConnecti on = cn
End If
.CommandTimeout = 600
.Execute(lRecor dsAffected)
End With
With cmd.ActiveConne ction ** ERROR HERE AFTER 3RD EXECUTE
**
'put the native error in the errors collection
If .Errors.Count > 0 Then
Err.Raise(.Erro rs(0).NativeErr or, .Errors(0).Sour ce,
..Errors(0).Des cription)
End With
'try catch throw finally
If Err.Number = 0 Then
Execute = True
Else
Execute = False
MsgBox("Error in cDataServices.E xecute(). " & Err.Number &
" " & Err.Source & " " & Err.Description )
Err.Clear()
End If
cmd = Nothing
End Function
'builds the command object
Public Function BuildCommand(By Val 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.CommandTy peEnum.adCmdSto redProc
.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.DataTypeE num.adChar,
ADODB.DataTypeE num.adVarChar
FldLen = IIf(Len(fld.var Value) = 0, 1,
Len(fld.varValu e))
Case Else
FldLen = fld.intLen
End Select
'debug
fld.varValue = YesNull(fld.var Value)
strParams = strParams & vbCrLf & "Name = " &
fld.FieldName & " Value = " & fld.varValue
.Parameters.App end(.CreatePara meter(fld.Field Name,
fld.Datatype, ADODB.Parameter DirectionEnum.a dParamInput, 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
