the connection cannt be used to perform this operation. It may closed or not valid in this context error in vb6

I am trying to execute the query which stores recordset vales in sql db. when I am trying to execute that i am getting error like

the connection cannt be used to perform this operation. It may closed or not valid in this context error in vb6. Please help me to solve this issue.

' Write records to Database

    frmDNELoad.lblStatus.Caption = "Loading data into database......"
    Call FindServerConnection_NoMsg

    Dim lngRecCount As Long
    lngRecCount = 0
    rcdDNE.MoveFirst

    Set rcdReclamation = New ADODB.Recordset
    With rcdReclamation
        .ActiveConnection = objConn
        .Source = "insert into t_DATA_DneFrc (RTN, AccountNbr, FirstName, MiddleName, LastName, Amount) values ('" & rcdDNE("RTN") & "', '" & rcdDNE("AccountNbr") & "', '" & rcdDNE("FirstName") & "', '" & rcdDNE("MiddleName") & "', '" & rcdDNE("LastName") & "', '" & rcdDNE("Amount") & "')"
        .CursorType = adOpenDynamic
        .CursorLocation = adUseClient
        .LockType = adLockOptimistic
        .Open cmdCommand
    End With

    Do Until rcdDNE.EOF
        lngRecCount = lngRecCount + 1
        frmDNELoad.lblStatus.Caption = "Adding record " & lngRecCount & " of " & rcdDNE.RecordCount & " to database."
        frmDNELoad.Refresh
        DoEvents
        Call CommitNew
        rcdDNE.MoveNext
    Loop

    frmDNELoad.lblStatus.Caption = "DNE Processing Complete."
    frmDNELoad.Refresh

End Function

Sub CommitNew()
   ' Add records to DneFrc table
    With rcdReclamation
        .Requery
        .AddNew
        .Fields![RTN] = rcdDNE.Fields![RTN]
        .Fields![AccountNbr] = rcdDNE.Fields![AccountNbr]
        .Fields![FirstName] = rcdDNE.Fields![FirstName]
        .Fields![MiddleName] = rcdDNE.Fields![MiddleName]
        .Fields![LastName] = rcdDNE.Fields![LastName]
        .Fields![Amount] = rcdDNE.Fields![Amount]
        .Update

    End With

End Sub

conection code

Sub InstantiateCommand_SQLText()
    ' Creates a command object to be used when executing SQL statements.
    Set objCommSQLText = New ADODB.Command
    objCommSQLText.ActiveConnection = objConn
    objCommSQLText.CommandType = adCmdText
End Sub

Function FindServerConnection_NoMsg() As String

    Dim rcdClientPaths As ADODB.Recordset
    Dim strDBTemp As String
    Const CLIENT_UPDATE_DIR = "\\PSGSPHX02\NORS\Rs\ClientUpdate\"

    On Error Resume Next
    ' If persisted recordset is not there, try and copy one down from
    ' CLIENT_UPDATE_DIR.  If that can't be found, create a blank one
    ' and ask the user for the server name.
    Set rcdClientPaths = New ADODB.Recordset
    ' Does it already exist locally?
    If FileExists_FullPath(App.Path & "\" & "t_PCD_ServerConnectionList.xml") = False Then
        ' Can it be retrieved from CLIENT_UPDATE_DIR
        If Dir(CLIENT_UPDATE_DIR & "t_PCD_ServerConnectionList.xml")  "" Then
            FileCopy CLIENT_UPDATE_DIR & "t_PCD_ServerConnectionList.xml", App.Path & "\" & "t_PCD_ServerConnectionList.xml"
        Else
            ' Creat a blank one.
            With rcdClientPaths
                .Fields.Append "ServerConnection", adVarChar, 250
                .Fields.Append "Description", adVarChar, 50
                .CursorType = adOpenDynamic
                .LockType = adLockOptimistic
                .CursorLocation = adUseClient
                .Open
                .Save App.Path & "\" & "t_PCD_ServerConnectionList.xml", adPersistXML
                .Close
            End With
        End If
    End If

    ' Open the recordset
    With rcdClientPaths
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        .CursorLocation = adUseClient
        .Open App.Path & "\" & "t_PCD_ServerConnectionList.xml", , , , adCmdFile
    End With

    If rcdClientPaths.RecordCount  0 Then
        ' try each one listed
        rcdClientPaths.MoveFirst
        Do Until rcdClientPaths.EOF
            strDBTemp = TryConnection_NoMsg(rcdClientPaths.Fields![serverconnection])
            If strDBTemp  "" Then
       开发者_开发百科         FindServerConnection_NoMsg = strDBTemp
                Exit Function
            End If
            rcdClientPaths.MoveNext
        Loop
        strDBTemp = ""
    End If

    Do While strDBTemp = ""
        If strDBTemp  "" Then
            strDBTemp = TryConnection_NoMsg(strDBTemp)
            If strDBTemp  "" Then
                With rcdClientPaths
                    .AddNew
                    .Fields![serverconnection] = strDBTemp
                    .Update
                    .Save
                End With
                FindServerConnection_NoMsg = strDBTemp
                Exit Function
            End If
        Else
            Exit Function
        End If
    Loop
End Function

Function TryConnection_NoMsg(ByVal SvName As String) As String
    On Error GoTo ErrHandle
    ' If a server was provided, try to open a connection to it.
    Screen.MousePointer = vbHourglass
    Set objConn = New ADODB.Connection
    With objConn
        .CommandTimeout = 30
        .ConnectionTimeout = 30
        .ConnectionString = "Provider=SQLOLEDB.1; Server=" & SvName & "; User ID=RS_Auth; Password=weLcomers_auth; Initial Catalog=NORS" ' Test
        .Open
        .Close
    End With
    Set objConn = Nothing
    TryConnection_NoMsg = SvName
    Screen.MousePointer = vbNormal
    Exit Function

ErrHandle:
    TryConnection_NoMsg = ""
    Set objConn = Nothing
    Screen.MousePointer = vbNormal
    Exit Function

End Function

You have already closed the connection here in TryConnection_NoMsg function (?)

 With objConn
        .CommandTimeout = 30
        .ConnectionTimeout = 30
        .ConnectionString = "Provider=SQLOLEDB.1; Server=" & SvName & "; Database=NORS; User ID=RS_Auth; Password=weLcomers_auth; Initial Catalog=NORS" ' Test
        .Open
        .Close

I'd suspect that FindServerConnection_NoMsg is not managing to open the connection, and since it ends in NoMsg that you're not seeing the error about why the connection wasn't opened. You then go on to just use the connection without knowing that the open failed.

Post the code for FindServerConnection_NoMsg.

BTW, your question itself should have given you a clue. It specifically says that the connection can't be used, and that it may not be open. That should have told you where to start looking, and at the least told you you should have posted the code that opened the connection as part of your question.

Thanks for everyone. I sloved my problem. This what i cahnge in my code

Dim lngRecCount As Long lngRecCount = 0 rcdDNE.MoveFirst

 With cmdCommand
    .ActiveConnection = objConn
    .CommandText = "insert into t_DATA_DneFrc (RTN, AccountNbr, FirstName, MiddleName, LastName, Amount) values ('" & rcdDNE("RTN") & "', '" & rcdDNE("AccountNbr") & "', '" & rcdDNE("FirstName") & "', '" & rcdDNE("MiddleName") & "', '" & rcdDNE("LastName") & "', '" & rcdDNE("Amount") & "')"
    .CommandType = adCmdText

End With

Set rcddnefrc = New ADODB.Recordset
With rcddnefrc
    .ActiveConnection = objConn
    .Source = "SELECT * FROM T_DATA_DNEFRC"
    .CursorType = adOpenDynamic
    .CursorLocation = adUseClient
    .LockType = adLockOptimistic
    .Open
End With

Do Until rcdDNE.EOF
    lngRecCount = lngRecCount + 1
    frmDNELoad.lblStatus.Caption = "Adding record " & lngRecCount & " of " & rcdDNE.RecordCount & " to database."
    frmDNELoad.Refresh
    DoEvents
    Call CommitNew
    rcdDNE.MoveNext
Loop

frmDNELoad.lblStatus.Caption = "DNE Processing Complete."
frmDNELoad.Refresh