error -2147217900 (80040e14)

[yohannita]

este codigo tengo en el boton guardar, donde m aparece este error. estee error aparecio cuando modifique unos datos en una tabla, no se que pueda ser, gracias

Public Sub save()
Dim clientId, activeStatus, i, contactId As Integer
Dim siEsta As Boolean

'Validar campos llenos
If AdminTool.txt_cname.Text = "" Then
MsgBox "The Client name field is empty", vbCritical
AdminTool.txt_cname.SetFocus
Exit Sub
End If
If AdminTool.chk_cactive.Value = 1 Then
activeStatus = 1
Else
activeStatus = 0
End If
If AdminTool.lst_contacts.ListItems.count = 0 Then
MsgBox "At least a contact must be related with current client", vbCritical
AdminTool.txt_contname.SetFocus
Exit Sub
End If

'Sacar el id que corresponde
Set rst1 = New ADODB.Recordset
rst1.Open "select id from client where name = '" & AdminTool.txt_cname.Text & "' ", de_TimeReportDB.cnn_TimeReportDB, , , adCmdText
If Not rst1.EOF Then 'MODIFICAR REGISTRO
'Sacar el id que corresponde
clientId = Val(rst1!id)
'registro previo client
strSQL = " Update client " & _
" Set active = " & activeStatus & ", " & _
" description = '" & AdminTool.txt_cdescription.Text & "' " & _
" where id = " & clientId & " "
de_TimeReportDB.cnn_TimeReportDB.Execute strSQL
Else 'NUEVO REGISTRO
'Sacar el id que corresponde
Set rst = New ADODB.Recordset
rst.Open "select MAX(id) from client", de_TimeReportDB.cnn_TimeReportDB, , , adCmdText
clientId = Val(rst.GetString) + 1
rst.Close
'Escribe registro en department
strSQL = "Insert into client values (" & clientId & ",'" & _
AdminTool.txt_cname.Text & "','" & AdminTool.txt_cdescription.Text & "','" & activeStatus & "')"
de_TimeReportDB.cnn_TimeReportDB.Execute strSQL
End If
rst1.Close

If AdminTool.lst_contacts.ListItems.count > 0 Then

Set rst2 = New ADODB.Recordset
rst2.Open "select id, name from contact where client_id = " & clientId, de_TimeReportDB.cnn_TimeReportDB, , , adCmdText

Do While Not rst2.EOF
'agregar registros contacts
siEsta = False
'Sacar el id que corresponde
contactId = Val(rst2!id)
For i = 1 To AdminTool.lst_contacts.ListItems.count
If Trim(rst2!name) = AdminTool.lst_contacts.ListItems.Item(i) Then siEsta = True
Next i
'borrarlo solo si no esta siendo utilizado en project
If siEsta = False Then
Set rst = New ADODB.Recordset
rst.Open "select id from project where contact_id=" & contactId, de_TimeReportDB.cnn_TimeReportDB, , , adCmdText
If Not rst.EOF Then
MsgBox "There is a project related to this contact information, please change/remove " & vbCrLf & "project information before removing this contact", vbCritical
Else
strSQL = " delete contact " & _
" where id = " & contactId & " "
de_TimeReportDB.cnn_TimeReportDB.Execute strSQL
End If
rst.Close
End If
rst2.MoveNext
Loop
rst2.Close

For i = 1 To AdminTool.lst_contacts.ListItems.count
Set rst = New ADODB.Recordset
rst.Open "select id from contact where name = '" & AdminTool.lst_contacts.ListItems.Item(i) & "' and client_id = " & clientId & " ", de_TimeReportDB.cnn_TimeReportDB, , , adCmdText
If rst.EOF Then
'Sacar el id que corresponde
Set rst1 = New ADODB.Recordset
rst1.Open "select MAX(id) from contact ", de_TimeReportDB.cnn_TimeReportDB, , , adCmdText
contactId = Val(rst1.GetString) + 1
rst1.Close
strSQL = "Insert into contact values (" & contactId & "," & _
clientId & ",'" & AdminTool.lst_contacts.ListItems.Item(i) & "','" & AdminTool.lst_contacts.ListItems.Item(i).SubItems( 1) & "')"
de_TimeReportDB.cnn_TimeReportDB.Execute strSQL
End If
rst.Close
Next i
Else
'Sacar el id que corresponde
Set rst1 = New ADODB.Recordset
rst1.Open "select MAX(id) from contact", de_TimeReportDB.cnn_TimeReportDB, , , adCmdText
contactId = Val(rst1.GetString) + 1
rst1.Close
strSQL = "Insert into contact values (" & contactId & "," & _
clientId & ",'none',' ')"
de_TimeReportDB.cnn_TimeReportDB.Execute strSQL
End If

'Refrescar lista de clientes
Call Get_Client_List

End Sub