Runtime Error : '3367' in vb6

[santhanalakshmi]

Hi,

By clicking the button first time - it opens the form.

if i try the same thing(in second time) .....In my form only one textbox(using as a lostfocus and also using recordset[sql])

Runtime Error '3367' : Object is already in collection.Cannot Append.

Please ,help me out..........thanks in advance............

[vb5prgrmr]

Without seeing your code it is hard to guess what exactly is going on but from the sounds of it, you have not fully unloaded the form when you try and show it again.

Good Luck

[santhanalakshmi]

Without seeing your code it is hard to guess what exactly is going on but from the sounds of it, you have not fully unloaded the form when you try and show it again.

Good Luck

hi,
please see my code and i have bolded the line where i am facing an error by clicking the button second time

Private rs As New ADODB.Recordset
Private selcmdcount As New ADODB.Command
Private selcmdname As New ADODB.Command
Private selcmdcrse As New ADODB.Command
Private selcmdcrseid As New ADODB.Command
Private selcmdsqlno As New ADODB.Command
Private inscmdupsql As New ADODB.Command
Private inscmdmsgrade As New ADODB.Command
Private delcmdmsgrade As New ADODB.Command
Private prollno As New ADODB.Parameter
Private pcrseno As New ADODB.Parameter
Private pcrseid As New ADODB.Parameter
Private psem As New ADODB.Parameter
Private pperiod As New ADODB.Parameter
Private pcategory As New ADODB.Parameter
Private pctype As New ADODB.Parameter
Private pmarks As New ADODB.Parameter
Private pgrade As New ADODB.Parameter
Private patt As New ADODB.Parameter
Private pslot As New ADODB.Parameter
Private psqluser As New ADODB.Parameter
Private psqlno As New ADODB.Parameter
Private psqldate As New ADODB.Parameter
Private psqltime As New ADODB.Parameter
Private psqlstr As New ADODB.Parameter
Private flexvalue As String

Dim dummy As String
Dim lastkey As Integer
Dim freeze As Variant

Private Sub cmdup_Click()
Dim i, n As Integer
i = 1
n = fgregn.Rows
cn.BeginTrans
pperiod = txtperiod.Text
If Len(Trim(prollno)) = 0 Then
MsgBox "Please enter the rollno"
txtrollno.SetFocus
Exit Sub
' ElseIf Len(Trim(psem)) = 0 Then
' MsgBox "Please enter the semester"
' txtsem.SetFocus
' Exit Sub
ElseIf Len(Trim(pperiod)) = 0 Then
MsgBox "Please enter the period"
txtperiod.SetFocus
Exit Sub
Else
Do While i < n
pcrseno = Trim(fgregn.TextMatrix(i, 0))
If pcrseno <> "" Then
Set rs = selcmdcrseid.Execute
pcrseid = rs!crseid
'rs.Close
If Len(Trim(pcrseno)) > 0 Then
psem = fgregn.TextMatrix(i, 4)
pmarks = fgregn.TextMatrix(i, 5)
pgrade = fgregn.TextMatrix(i, 6)
patt = fgregn.TextMatrix(i, 7)
pcategory = ""
pctype = ""
qstr = "'"

psqluser = pubuid

Set rs = selcmdsqlno.Execute
If IsNull(rs!sqlno) Then
psqlno = 1
'rs.Close
Else
psqlno = rs!sqlno + 1
'rs.Close
End If

If Len(Trim(pmarks)) = 0 Then
pmarks = "0"
End If

If pmarks <> "0" And Len(Trim(pgrade)) <> 0 And Len(Trim(patt)) <> 0 Then

psqlstr = "insert into msgrade (rollno,crseid,category,ctype,semester,marks,grade,att,period) values (" + _
qstr + prollno + qstr + "," + qstr + pcrseid + qstr + "," + qstr + pcategory + qstr + "," + qstr + pctype + qstr + "," + qstr + psem + qstr + "," + _
qstr + pmarks + qstr + "," + qstr + pgrade + qstr + "," + qstr + patt + qstr + "," + qstr + pperiod + qstr + ")"

psqldate = Format(Date, "yyyy/mm/dd")
psqltime = Time
inscmdupsql.Execute
inscmdmsgrade.Execute

psqlno = psqlno + 1

psqlstr = "delete from mscrnrgdet where rollno = " + qstr + prollno + qstr + _
" and crseid = " + qstr + pcrseid + qstr + " and semester = " + qstr + psem + qstr
psqldate = Format(Date, "yyyy/mm/dd")
psqltime = Time
inscmdupsql.Execute
delcmdmsgrade.Execute

End If

' If pmarks <> "0" And Len(Trim(pgrade)) <> 0 And Len(Trim(patt)) <> 0 Then
' inscmdmsgrade.Execute
' delcmdmsgrade.Execute
' End If
End If

End If
i = i + 1
Loop
cn.CommitTrans
cmdcl_Click
End If
End Sub

Private Sub Form_Load()
With prollno
.Direction = adParamInput
.Type = adVarChar
.Size = 8
End With
With pcrseno
.Direction = adParamInput
.Type = adVarChar
.Size = 7
End With
With pcrseid
.Direction = adParamInput
.Type = adVarChar
.Size = 4
End With
With psem
.Direction = adParamInput
.Type = adVarChar
.Size = 2
End With
With pcategory
.Direction = adParamInput
.Type = adVarChar
.Size = 3
End With
With pctype
.Direction = adParamInput
.Type = adVarChar
.Size = 4
End With
With pmarks
.Direction = adParamInput
.Type = adVarChar
.Size = 2
End With
With pgrade
.Direction = adParamInput
.Type = adVarChar
.Size = 1
End With
With patt
.Direction = adParamInput
.Type = adVarChar
.Size = 2
End With
With pslot
.Direction = adParamInput
.Type = adVarChar
.Size = 1
End With
With psqluser
.Direction = adParamInput
.Type = adVarChar
.Size = 8
End With
With psqlno
.Direction = adParamInput
.Type = adInteger
.Size = 10
End With
With psqldate
.Direction = adParamInput
.Type = adVarChar
.Size = 10
End With
With psqltime
.Direction = adParamInput
.Type = adVarChar
.Size = 8
End With
With pperiod
.Direction = adParamInput
.Type = adVarChar
.Size = 12
End With
With psqlstr
.Direction = adParamInput
.Type = adVarChar
.Size = 300
End With
With selcmdcount
.ActiveConnection = cn
.CommandType = adCmdText
.CommandText = "select count(rollno) as mcount from stuacmst where rollno=? and programme in ('S','D')"
.Parameters.Append prollno
End With
With selcmdname
.ActiveConnection = cn
.CommandType = adCmdText
.CommandText = "select name,programme from stuacmst where rollno=? and programme in ('S','D')"
.Parameters.Append prollno

End With
With selcmdcrse
.ActiveConnection = cn
.CommandType = adCmdText
.CommandText = "select b.crseno,b.crsename,c.category,c.ctype,c.semester,c.marks,c.grade,c.att,c.slot from corsemst b,mscrnrgdet c where c.rollno=? and b.crseid=c.crseid order by c.semester"
.Parameters.Append prollno
'.Parameters.Append psem
End With
With selcmdcrseid
.ActiveConnection = cn
.CommandType = adCmdText
.CommandText = "select distinct crseid from corsemst where crseno=? and wdrawdate='1900-01-01 00:00:00.000'"
.Parameters.Append pcrseno
End With
With selcmdsqlno
.ActiveConnection = cn
.CommandType = adCmdText
.CommandText = "select max(sqlno) as sqlno from msupsqllog where sqluser = ?"
.Parameters.Append psqluser
End With
With inscmdupsql
.ActiveConnection = cn
.CommandType = adCmdText
.CommandText = "insert into msupsqllog values(?,?,?,?,?)"
.Parameters.Append psqluser
.Parameters.Append psqlno
.Parameters.Append psqldate
.Parameters.Append psqltime
.Parameters.Append psqlstr
End With
With inscmdmsgrade
.ActiveConnection = cn
.CommandType = adCmdText
.CommandText = "insert into msgrade(rollno,crseid,category,ctype,semester,marks,grade,att,period)values(?,?,?,?,?,?,?,?,?)"
.Parameters.Append prollno
.Parameters.Append pcrseid
.Parameters.Append pcategory
.Parameters.Append pctype
.Parameters.Append psem
.Parameters.Append pmarks
.Parameters.Append pgrade
.Parameters.Append patt
.Parameters.Append pperiod
End With
With delcmdmsgrade
.ActiveConnection = cn
.CommandType = adCmdText
.CommandText = "delete from mscrnrgdet where rollno=? and crseid=? and semester=?"
.Parameters.Append prollno
.Parameters.Append pcrseid
.Parameters.Append psem
End With
fgregn.ColWidth(1) = 4455
fgregn.ColWidth(2) = 0
fgregn.ColWidth(3) = 0
fgregn.ColWidth(4) = 700
fgregn.ColWidth(5) = 700
fgregn.ColWidth(6) = 675
fgregn.ColWidth(7) = 675
fgregn.ColWidth(8) = 0
fgregn.ColAlignment(7) = 0

fgregn.TextMatrix(0, 0) = "Crseno"
fgregn.TextMatrix(0, 1) = "Crsename"
fgregn.TextMatrix(0, 4) = "Sem"
fgregn.TextMatrix(0, 5) = "Marks"
fgregn.TextMatrix(0, 6) = "Grade"
fgregn.TextMatrix(0, 7) = "Att"
freeze = Array(0, 1, 2, 3, 4, 8)
lastkey = -1
oldgrade = " "

End Sub
Private Sub cmdexit_Click()
Unload Me
'txtrollno = ""
Set msphdgradenter = Nothing
End Sub

Private Sub txtperiod_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii))) 'Textbox - uppercase
End Sub
Private Sub txtrollno_KeyPress(KeyAscii As Integer)
KeyAscii = Asc(UCase(Chr(KeyAscii))) 'Textbox - uppercase
End Sub
Private Sub txtrollno_LostFocus()
Dim i, n As Integer
If Len(Trim(txtrollno)) <> 0 Then
If Len(Trim(txtrollno)) < 8 Then
MsgBox "Please enter a valid 8 digit rollno"
txtrollno.SetFocus
Exit Sub
Else
dummy = txtrollno.Text
prollno = dummy
Set rs = selcmdcount.Execute
If rs!mcount > 0 Then
Set rs = selcmdname.Execute
lbname2.Caption = rs!Name
lbprogramme2.Caption = rs!programme
Set rs = selcmdcrse.Execute
i = 1
While Not rs.EOF
tmpfgregn.AddItem ("")
tmpfgregn.TextMatrix(i, 0) = rs!crseno
tmpfgregn.TextMatrix(i, 1) = rs!crsename
tmpfgregn.TextMatrix(i, 2) = Format(rs!category, "@@@")
tmpfgregn.TextMatrix(i, 3) = Format(rs!ctype, "@")
tmpfgregn.TextMatrix(i, 4) = Format(rs!semester, "@@")
tmpfgregn.TextMatrix(i, 5) = Format(rs!MARKS, "@@")
tmpfgregn.TextMatrix(i, 6) = Format(rs!grade, "@")
tmpfgregn.TextMatrix(i, 7) = Format(rs!att, "@")
tmpfgregn.TextMatrix(i, 8) = Format(rs!slot, "@")
rs.MoveNext
i = i + 1
Wend
n = tmpfgregn.Rows
i = 1
Do While i < n
If i > 11 Then
fgregn.AddItem ""
End If
fgregn.TextMatrix(i, 0) = tmpfgregn.TextMatrix(i, 0)
fgregn.TextMatrix(i, 1) = tmpfgregn.TextMatrix(i, 1)
fgregn.TextMatrix(i, 2) = tmpfgregn.TextMatrix(i, 2)
fgregn.TextMatrix(i, 3) = tmpfgregn.TextMatrix(i, 3)
fgregn.TextMatrix(i, 4) = tmpfgregn.TextMatrix(i, 4)
fgregn.TextMatrix(i, 5) = tmpfgregn.TextMatrix(i, 5)
fgregn.TextMatrix(i, 6) = tmpfgregn.TextMatrix(i, 6)
fgregn.TextMatrix(i, 7) = tmpfgregn.TextMatrix(i, 7)
fgregn.TextMatrix(i, 8) = tmpfgregn.TextMatrix(i, 8)
i = i + 1
Loop
fgregn.Row = 1
Else
MsgBox "No Records Found"
End If
End If
End If
End Sub

Private Sub fgregn_GotFocus()
Dim c As Variant
c = fgregn.Col
Select Case c
Case 0
Text1.Alignment = 0
Text1.MaxLength = 8
GridEdit Text1
Case 1
GridEdit Text1
Case 2
GridEdit Text1
Case 3
GridEdit Text1
Case 4
GridEdit Text1
Case 5
Text1.Alignment = 1
Text1.MaxLength = 2
GridEdit Text1
Case 6
Text1.Alignment = 0
Text1.MaxLength = 1
GridEdit Text1
Case 7
Text1.Alignment = 0
Text1.MaxLength = 2
GridEdit Text1
Case 8
GridEdit Text1
End Select
End Sub
Private Sub GridEdit(edt As Control)
If fgregn.ColWidth(fgregn.Col) > 0 Then
edt.FontName = fgregn.FontName
edt.FontSize = fgregn.FontSize
edt.Left = fgregn.CellLeft + fgregn.Left
edt.Top = fgregn.CellTop + fgregn.Top
edt.Width = fgregn.CellWidth
edt.Height = fgregn.CellHeight
edt = fgregn
edt.SelStart = 0
edt.SelLength = edt.Width
End If
edt.Visible = True
edt.SetFocus
End Sub
Private Sub Text1_GotFocus()
Dim c As Variant
Dim f As Boolean
flexvalue = fgregn
fgregn.TabStop = False
txtrollno.TabStop = False
txtperiod.TabStop = False
'txtsem.TabStop = False
cmdup.TabStop = False
cmdcl.TabStop = False
cmdexit.TabStop = False
f = False
For Each c In freeze
If fgregn.Col = c Then
f = True
End If
Next
If f = True Then
Select Case lastkey
Case vbKeyTab, vbKeyRight, vbKeyReturn, -1
If fgregn.Col < fgregn.Cols - 1 Then
fgregn.Col = fgregn.Col + 1
Else
If fgregn.Row < fgregn.Rows - 1 Then
fgregn.Row = fgregn.Row + 1
End If
fgregn.Col = 0
End If
Case vbKeyLeft
If fgregn.Col > 0 Then
fgregn.Col = fgregn.Col - 1
Else
fgregn.Col = fgregn.Cols - 1
End If
End Select
End If
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyEscape
Text1.Visible = False
fgregn.SetFocus
Case vbKeyReturn
If fgregn.Col = fgregn.Cols - 1 Then
If fgregn.Row < fgregn.Rows - 1 Then
fgregn.Row = fgregn.Row + 1
End If
fgregn.Col = 0
Else
fgregn.Col = fgregn.Col + 1
End If
Case vbKeyDown
If fgregn.Row < fgregn.Rows - 1 Then
fgregn.Row = fgregn.Row + 1
End If
Case vbKeyUp
If fgregn.Row > 1 Then
fgregn.Row = fgregn.Row - 1
End If
Case vbKeyLeft
If fgregn.Col > 0 Then
fgregn.Col = fgregn.Col - 1
End If
Case vbKeyRight
If fgregn.Col < fgregn.Cols - 1 Then
fgregn.Col = fgregn.Col + 1
End If
Case vbKeyF2
fgregn.SetFocus
If fgregn.Rows > 2 Then
fgregn.RemoveItem (fgregn.Row)
Else
fgregn.AddItem ""
fgregn.RemoveItem (fgregn.Row)
End If
End Select
lastkey = KeyCode
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyTab Then
If fgregn.Col < fgregn.Cols - 1 Then
fgregn.Col = fgregn.Col + 1
Else
If fgregn.Row < fgregn.Rows - 1 Then
fgregn.Row = fgregn.Row + 1
fgregn.Col = 0
End If
End If
lastkey = vbKeyTab
End If
KeyAscii = Asc(UCase(Chr(KeyAscii)))
End Sub
Private Sub fgregn_LeaveCell()
Dim c As Integer
If Text1.Visible = True Then
c = fgregn.Col
Select Case c
Case 5
fgregn = Text1
'computegrade (Val(Text1))

Case 6
validategrade (Text1)
fgregn = Text1
Case 7
validateatt (Text1)
fgregn = Text1
End Select

Text1.Visible = False
fgregn.SetFocus
End If
End Sub

Private Sub validategrade(vgrade As String)
If vgrade <> "S" And vgrade <> "A" And vgrade <> "B" And vgrade <> "C" And vgrade <> "D" And vgrade <> "E" And vgrade <> "U" And vgrade <> "W" And vgrade <> "P" And vgrade <> "F" And vgrade <> "X" And vgrade <> "Y" And vgrade <> "I" And vgrade <> " " And vragde <> "*" And vgrade <> "R" And vgrade <> "" Then
MsgBox "Invalid grade"
Text1 = ""
End If
End Sub
Private Sub validateatt(vatt As String)
'If vatt <> "H" And vatt <> "9" And vatt <> "8" And vatt <> "L" And vatt <> "P" And vatt <> "M" And vatt <> "G" And vatt <> "VG" And vatt <> " " And vatt <> "" Then
If vatt <> "P" And vatt <> "M" And vatt <> "G" And vatt <> "VG" And vatt <> " " And vatt <> "" Then
MsgBox "Invalid att"
Text1 = ""
End If
End Sub
Private Sub Text1_LostFocus()
fgregn.TabStop = True
txtrollno.TabStop = True
txtperiod.TabStop = True
cmdup.TabStop = True
cmdcl.TabStop = True
cmdexit.TabStop = True
'txtsem.TabStop = True

End Sub
Private Sub cmdcl_Click()
Text1.Text = ""
Text1.Visible = False
txtperiod.Text = ""
' txtsem.Text = ""
Clear_Flexgrid
txtrollno.Text = ""
lbname2.Caption = ""
lbprogramme2.Caption = ""
txtrollno.SetFocus
End Sub

Private Sub Clear_Flexgrid()
Dim i, n As Integer
i = 2
n = fgregn.Rows
Do While i < n
fgregn.RemoveItem fgregn.Row
i = i + 1
Loop
fgregn.AddItem ""
fgregn.RemoveItem fgregn.Row
i = 2
Do While i < 12
fgregn.AddItem ""
i = i + 1
Loop
i = 1
n = tmpfgregn.Rows
For i = n - 1 To 1 Step -1
tmpfgregn.RemoveItem i
Next i
End Sub

[vb5prgrmr]

Okay, in the click event of your command button that closes the form or in form_unload you need to close all your objects and set them to nothing...

Rs.Close
Set Rs = Nothing

and that goes for your command objects, parameter objects, recordsets, connections, and so on for everything that you have declared within this form.

Good Luck

[santhanalakshmi]

Okay, in the click event of your command button that closes the form or in form_unload you need to close all your objects and set them to nothing...

Rs.Close
Set Rs = Nothing

and that goes for your command objects, parameter objects, recordsets, connections, and so on for everything that you have declared within this form.

Good Luck

hi,

Thanks a lot.Now ,its working fine.I have added this line in the EXIT BUTTON.Thanks very much....................

[vb5prgrmr]

Glad I could help, if you don't mind, could you please mark this thread as solved.

Thanks and Good Luck

[santhanalakshmi]

Glad I could help, if you don't mind, could you please mark this thread as solved.

Thanks and Good Luck

Ok....I Marked As Solved.