-1

SQL db にレコードセット値を格納するクエリを実行しようとしています。実行しようとすると、次のようなエラーが発生します

この接続を使用してこの操作を実行することはできません。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()
    ' SQL ステートメントの実行時に使用するコマンド オブジェクトを作成します。
    objCommSQLText を設定 = New ADODB.Command
    objCommSQLText.ActiveConnection = objConn
    objCommSQLText.CommandType = adCmdText
サブ終了

関数 FindServerConnection_NoMsg() を文字列として

    Dim rcdClientPaths As ADODB.Recordset
    文字列としての暗い strDBTemp
    Const CLIENT_UPDATE_DIR = "\\PSGSPHX02\NORS\Rs\ClientUpdate\"

    エラー時再開次へ
    ' 永続化されたレコードセットがない場合は、1 つコピーしてみてください
    ' CLIENT_UPDATE_DIR. それが見つからない場合は、空のものを作成します
    ' ユーザーにサーバー名を尋ねます。
    rcdClientPaths = New ADODB.Recordset を設定します。
    ' すでにローカルに存在しますか?
    If FileExists_FullPath(App.Path & "\" & "t_PCD_ServerConnectionList.xml") = False Then
        ' 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"
        そうしないと
            ' 空白を作成します。
            rcdClientPaths を使用
                .Fields.Append "ServerConnection", adVarChar, 250
                .Fields.Append "説明", adVarChar, 50
                .CursorType = adOpenDynamic
                .LockType = adLockOptimistic
                .CursorLocation = adUseClient
                。開ける
                .Save App.Path & "\" & "t_PCD_ServerConnectionList.xml", adPersistXML
                。近い
            で終わる
        終了条件
    終了条件

    ' レコードセットを開く
    rcdClientPaths を使用
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        .CursorLocation = adUseClient
        .Open App.Path & "\" & "t_PCD_ServerConnectionList.xml", , , adCmdFile
    で終わる

    If rcdClientPaths.RecordCount 0 Then
        ' リストされているそれぞれを試してください
        rcdClientPaths.MoveFirst
        rcdClientPaths.EOF まで行う
            strDBTemp = TryConnection_NoMsg(rcdClientPaths.Fields![サーバー接続])
            If strDBTemp "" その後
                FindServerConnection_NoMsg = strDBTemp
                終了機能
            終了条件
            rcdClientPaths.MoveNext
        ループ
        strDBTemp = ""
    終了条件

    Do While strDBTemp = ""
        If strDBTemp "" その後
            strDBTemp = TryConnection_NoMsg(strDBTemp)
            If strDBTemp "" その後
                rcdClientPaths を使用
                    。新しく追加する
                    .Fields![サーバー接続] = strDBTemp
                    。アップデート
                    。保存
                で終わる
                FindServerConnection_NoMsg = strDBTemp
                終了機能
            終了条件
        そうしないと
            終了機能
        終了条件
    ループ
終了機能

関数 TryConnection_NoMsg(ByVal SvName As String) As String
    エラー時 GoTo ErrHandle
    ' サーバーが提供されている場合は、そのサーバーへの接続を開こうとします。
    Screen.MousePointer = vbHourglass
    objConn = New ADODB.Connection を設定します。
    objConn を使用
        .CommandTimeout = 30
        .ConnectionTimeout = 30
        .ConnectionString = "Provider=SQLOLEDB.1; Server=" & SvName & "; User ID=RS_Auth; Password=weLcomers_auth; Initial Catalog=NORS" ' Test
        。開ける
        。近い
    で終わる
    objConn = Nothing に設定
    TryConnection_NoMsg = SvName
    Screen.MousePointer = vbNormal
    終了機能

エラーハンドル:
    TryConnection_NoMsg = ""
    objConn = Nothing に設定
    Screen.MousePointer = vbNormal
    終了機能

終了機能
4

3 に答える 3

1

ここの関数で既に接続を閉じてい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
于 2009-11-30T16:12:59.793 に答える
0

FindServerConnection_NoMsg接続を開くことができていないのではないかと思いNoMsgます。接続が開かれなかった理由についてのエラーが表示されないということになります。次に、オープンが失敗したことを知らずに、接続を使用し続けます。

のコードを投稿しますFindServerConnection_NoMsg。

ところで、あなたの質問自体が手がかりになるはずです。具体的には、接続を使用できないこと、および開いていない可能性があることを示しています。それは、どこから探し始めるかを教えてくれるはずであり、少なくとも、接続を開いたコードを質問の一部として投稿する必要があることを伝えているはずです.

于 2009-11-27T19:28:11.653 に答える