I'm working on this program on VB 6.0 enterprise Edition and I'm having the following issue. The second time I tri to run the procedure it returnes an run time error 3709 stating the the connection can not be use because is either out of context or closed.
Any sugestion will be appreciated.
Here is the Code:
Private Sub TxtFllr(uFilter As Boolean, iFilter As Boolean)
Dim iCount As Integer
Dim iSql As String
Dim InspecId As String
iSql = "select Inspection_ID_Num, " & _
"Inspection_Complete, " & _
"User_ID_Num, " & _
"Inspection_Date_Dtm, " & _
"Remarks " & _
"from qry_inspections"
If InspecId <> "" Then
iSql = iSql & " where Inspection_ID_Num = '" & InspecId & "'"
If uFilter = True Then
iSql = iSql & " and User_ID_Num = " & gUsrId
End If
If SortCheck1.Value = 1 Then
iSql = iSql & "and Inspection_Complete = No"
End If
Else
If SortCheck1.Value = 1 Then
iSql = iSql & " where Inspection_Complete = No"
If uFilter = True Then
iSql = iSql & " and User_ID_Num = " & gUsrId
End If
Else
If uFilter = True Then
iSql = iSql & " where User_ID_Num = " & gUsrId
End If
End If
End If
On Error GoTo GetConn_Fail
'Declares and opens Connection to Db
Dim Conn1 As New ADODB.Connection
Set Conn1 = gSession.iADSysDataConnect
If Conn1 Is Nothing Then Exit Sub
If Conn1.State = adStateClosed Then
Conn1.Open
Else
Conn1.Close
Conn1.Open
End If
' Conn1.Open
'Declares and populates Recordset of data
Dim iAdRs1 As New ADODB.Recordset
Dim iItem As Integer
Set iAdRs1 = gSession.rsqry_inspection
If iAdRs1 Is Nothing Then Exit Sub
If iAdRs1.State = adStateClosed Then
iAdRs1.Open iSql, , , adLockReadOnly
Else
iAdRs1.Close
iAdRs1.Open iSql, , , adLockReadOnly
End If
' iAdRs1.Open iSql, , , adLockReadOnly
iCount = iAdRs1.RecordCount
iItem = 0
If iCount > 0 Then
If Not iAdRs1.EOF Then
If iAdRs1.BOF Then
While Not iAdRs1.EOF
AFDataList1.AddItem (iAdRs1("Inspection_ID_Num"
& _
DisplaySpaces(3) & _
DisplayBol(iAdRs1("Inspection_Complete"
) & _
DisplaySpaces(3) & _
iAdRs1("User_ID_Num"
& _
DisplaySpaces(3) & _
FormatDateTime(iAdRs1("Inspection_Date_Dtm"
, vbShortDate) & _
DisplaySpaces(11 - Len(FormatDateTime(iAdRs1("Inspection_Date_Dtm"
, vbShortDate))) & _
FormatDateTime(iAdRs1("Inspection_Date_Dtm"
, vbShortTime)), iItem
iItem = iItem + 1
Wend
Else
iAdRs1.MoveFirst
While Not iAdRs1.EOF
AFDataList1.AddItem (iAdRs1("Inspection_ID_Num"
& _
DisplaySpaces(3) & _
DisplayBol(iAdRs1("Inspection_Complete"
) & _
DisplaySpaces(3) & _
iAdRs1("User_ID_Num"
& _
DisplaySpaces(3) & _
FormatDateTime(iAdRs1("Inspection_Date_Dtm"
, vbShortDate) & _
DisplaySpaces(11 - Len(FormatDateTime(iAdRs1("Inspection_Date_Dtm"
, vbShortDate))) & _
FormatDateTime(iAdRs1("Inspection_Date_Dtm"
, vbShortTime)), iItem
iAdRs1.MoveNext
iItem = iItem + 1
Wend
End If
Else
iAdRs1.MoveFirst
While Not iAdRs1.EOF
AFDataList1.AddItem (iAdRs1("Inspection_ID_Num"
& _
DisplaySpaces(3) & _
DisplayBol(iAdRs1("Inspection_Complete"
) & _
DisplaySpaces(3) & _
iAdRs1("User_ID_Num"
& _
DisplaySpaces(3) & _
FormatDateTime(iAdRs1("Inspection_Date_Dtm"
, vbShortDate) & _
DisplaySpaces(11 - Len(FormatDateTime(iAdRs1("Inspection_Date_Dtm"
, vbShortDate))) & _
FormatDateTime(iAdRs1("Inspection_Date_Dtm"
, vbShortTime)), iItem
iItem = iItem + 1
Wend
End If
End If
iAdRs1.Close
Set iAdRs1 = Nothing
Conn1.Close
Set Conn1 = Nothing
Exit Sub
GetConn_Fail:
MsgBox Err.Description & " in iAdRs1", vbCritical, Err.Source
End Sub
AL Almeida
NT/DB Admin
"May all those that come behind us, find us faithfull"
Any sugestion will be appreciated.
Here is the Code:
Private Sub TxtFllr(uFilter As Boolean, iFilter As Boolean)
Dim iCount As Integer
Dim iSql As String
Dim InspecId As String
iSql = "select Inspection_ID_Num, " & _
"Inspection_Complete, " & _
"User_ID_Num, " & _
"Inspection_Date_Dtm, " & _
"Remarks " & _
"from qry_inspections"
If InspecId <> "" Then
iSql = iSql & " where Inspection_ID_Num = '" & InspecId & "'"
If uFilter = True Then
iSql = iSql & " and User_ID_Num = " & gUsrId
End If
If SortCheck1.Value = 1 Then
iSql = iSql & "and Inspection_Complete = No"
End If
Else
If SortCheck1.Value = 1 Then
iSql = iSql & " where Inspection_Complete = No"
If uFilter = True Then
iSql = iSql & " and User_ID_Num = " & gUsrId
End If
Else
If uFilter = True Then
iSql = iSql & " where User_ID_Num = " & gUsrId
End If
End If
End If
On Error GoTo GetConn_Fail
'Declares and opens Connection to Db
Dim Conn1 As New ADODB.Connection
Set Conn1 = gSession.iADSysDataConnect
If Conn1 Is Nothing Then Exit Sub
If Conn1.State = adStateClosed Then
Conn1.Open
Else
Conn1.Close
Conn1.Open
End If
' Conn1.Open
'Declares and populates Recordset of data
Dim iAdRs1 As New ADODB.Recordset
Dim iItem As Integer
Set iAdRs1 = gSession.rsqry_inspection
If iAdRs1 Is Nothing Then Exit Sub
If iAdRs1.State = adStateClosed Then
iAdRs1.Open iSql, , , adLockReadOnly
Else
iAdRs1.Close
iAdRs1.Open iSql, , , adLockReadOnly
End If
' iAdRs1.Open iSql, , , adLockReadOnly
iCount = iAdRs1.RecordCount
iItem = 0
If iCount > 0 Then
If Not iAdRs1.EOF Then
If iAdRs1.BOF Then
While Not iAdRs1.EOF
AFDataList1.AddItem (iAdRs1("Inspection_ID_Num"
DisplaySpaces(3) & _
DisplayBol(iAdRs1("Inspection_Complete"
DisplaySpaces(3) & _
iAdRs1("User_ID_Num"
DisplaySpaces(3) & _
FormatDateTime(iAdRs1("Inspection_Date_Dtm"
DisplaySpaces(11 - Len(FormatDateTime(iAdRs1("Inspection_Date_Dtm"
FormatDateTime(iAdRs1("Inspection_Date_Dtm"
iItem = iItem + 1
Wend
Else
iAdRs1.MoveFirst
While Not iAdRs1.EOF
AFDataList1.AddItem (iAdRs1("Inspection_ID_Num"
DisplaySpaces(3) & _
DisplayBol(iAdRs1("Inspection_Complete"
DisplaySpaces(3) & _
iAdRs1("User_ID_Num"
DisplaySpaces(3) & _
FormatDateTime(iAdRs1("Inspection_Date_Dtm"
DisplaySpaces(11 - Len(FormatDateTime(iAdRs1("Inspection_Date_Dtm"
FormatDateTime(iAdRs1("Inspection_Date_Dtm"
iAdRs1.MoveNext
iItem = iItem + 1
Wend
End If
Else
iAdRs1.MoveFirst
While Not iAdRs1.EOF
AFDataList1.AddItem (iAdRs1("Inspection_ID_Num"
DisplaySpaces(3) & _
DisplayBol(iAdRs1("Inspection_Complete"
DisplaySpaces(3) & _
iAdRs1("User_ID_Num"
DisplaySpaces(3) & _
FormatDateTime(iAdRs1("Inspection_Date_Dtm"
DisplaySpaces(11 - Len(FormatDateTime(iAdRs1("Inspection_Date_Dtm"
FormatDateTime(iAdRs1("Inspection_Date_Dtm"
iItem = iItem + 1
Wend
End If
End If
iAdRs1.Close
Set iAdRs1 = Nothing
Conn1.Close
Set Conn1 = Nothing
Exit Sub
GetConn_Fail:
MsgBox Err.Description & " in iAdRs1", vbCritical, Err.Source
End Sub
AL Almeida
NT/DB Admin
"May all those that come behind us, find us faithfull"