la connexion ne peut pas être utilisée pour effectuer cette opération. Il peut fermé ou non valide dans ce contexte erreur dans vb6

Question

Je suis en train d'exécuter la requête qui stocke les valeurs de recordset dans sql db. quand j'essaye d'exécuter que j'obtiens erreur comme

la connexion ne peut pas être utilisée pour effectuer cette opération. Il peut fermé ou non valide dans ce contexte erreur dans vb6. S'il vous plaît aidez-moi à résoudre ce problème.

' 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 

Code conection

 
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 

Answer 1

Je pense que FindServerConnection_NoMsg ne parvient pas à ouvrir la connexion, et comme il se termine par NoMsg que vous ne voyez pas l'erreur de savoir pourquoi la connexion n » était pas t ouvert. Vous allez ensuite simplement utiliser la connexion sans savoir que l'ouverture a échoué.

Postez le code pour FindServerConnection_NoMsg.

BTW, votre question en elle-même aurait dû vous donner un indice. Il dit spécifiquement que la connexion ne peut pas être utilisée, et qu'elle peut ne pas être ouverte. Cela aurait dû vous dire où commencer à regarder, et au moins vous a dit que vous auriez dû poster le code qui a ouvert la connexion dans le cadre de votre question.

Answer 2

Vous avez déjà fermé la connexion ici en fonction TryConnection_NoMsg (?)

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 

Answer 3

Merci pour avoir tout le monde. J'ai laissé tomber mon problème. Ce que je cahnge dans mon 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