连接不能用于执行此操作。它可能关闭或无效在这种情况下vb6

问题描述：

错误我试图执行存储SQL DB中的记录集值的查询。当我试图执行，我得到错误，如连接不能用于执行此操作。它可能关闭或无效在这种情况下vb6

连接不能用来执行此操作。它可能在vb6中的上下文错误中关闭或无效。请帮我解决这个问题。

' 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

连接如代码

 
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

几件事情cahnge：能否请您格式化代码的其余部分，所以它看起来像你一样第一部分？此外，错误在您的代码中发生在哪里？ – John 2009-11-27 19:18:52

@pbrp：我删除了一些相关的代码（并且完全搞乱了所有代码的格式），所以我回滚了最后一次编辑。如果您要编辑帖子，请学习如何格式化代码;从编辑页面可以找到帮助。 – 2009-11-27 20:34:09

你什么时候遇到这个错误？在哪些行动？ – Shoban 2009-11-30 16:05:42

答

我怀疑FindServerConnection_NoMsg不负责管理打开的连接，因为它在NoMsg，你没有看到关于为什么连接WASN的错误结束” t打开。然后，您继续只使用连接而不知道打开失败。

发布代码为FindServerConnection_NoMsg。

顺便说一句，你的问题本身应该给你一个线索。它明确指出连接不能使用，并且可能不会打开。这应该告诉你从哪里开始寻找，并且至少告诉过你应该发布打开连接的代码作为问题的一部分。

我添加了代码请通过它。谢谢你的帮助。 – pbrp 2009-11-27 20:20:31

从FindServerConnection_NoMsg中删除ON ERROR RESUME NEXT行并运行您的代码。错误消息应该告诉你问题是什么，以及它为什么发生。关于错误恢复NEXT基本上意味着“忽略任何错误，不要告诉我关于它们”，这正是导致你不知道发生了什么的原因。 – 2009-11-27 20:26:54

我评论说，行仍然是我得到相同的错误信息。 – pbrp 2009-11-27 20:29:29

答

你已经在这里关闭了连接在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

但我在InstantiateCommand_SP（）方法 – pbrp 2009-11-30 16:37:04

再次打开连接但是你有没有调用函数？我不能看到:) – Shoban 2009-11-30 18:16:35

答

感谢大家。我解决了我的问题。这是我在我的代码

昏暗lngRecCount只要 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

连接不能用于执行此操作。它可能关闭或无效在这种情况下vb6

相关推荐