Access (VBA)

Access VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10 Pro : Access 2016)
レコードセットが閉じれません
投稿日時: 20/06/17 14:13:26
投稿者: 7986

CSVファイルを読み込み、データチェックをしてテーブルに追加する処理を作成しました。
読み込んだデータのチェックをして、異常があれば処理を終了したいのですが、
終了のステップでレコードセットを閉じるときに、以下のエラーが出ます。
「このコンテキストで操作は許可されていません。」
 
閉じる前に、レコードセットのステータスが開いているか確認して、
開いている状態なのに閉じれないのはなぜでしょうか。。。
コードは以下の通りです。
 
Private Sub cmd結果取込_Click()
    On Error GoTo Err
 
    Dim txtData As String
    Dim FNo As Long
    Dim arrData As Variant
    Dim DB As New ADODB.Connection
    Dim RS1 As New ADODB.Recordset 'tbl_取込データ
    Dim RS2 As New ADODB.Recordset
    Dim JOKEN As String
     
    Dim lngINPUT_CNT As Long '取込ファイル件数(見出し行、ヘッダ行も含めたテキストファイル件数)
    Dim lngDATA_CNT As Long '取込データ件数(CSVファイル2行目のサブバッチ数)
    Dim lngLINE_CNT As Long '取込データ行カウント(見出し行、ヘッダ業を除いた試験データ件数)
    Dim lngOUTPUT_CNT As Long '出力件数
     
     
    DoCmd.Hourglass True
     
   '----- 取込ファイル選択のダイアログを表示 -----
    Call subFileOpen("ファイルを取り込む", "")
     
    If pbFile = "" Then 'pbFile:パブリック変数(選択されたファイル名)
            MsgBox "キャンセルされました。"
            DoCmd.Hourglass False
            Exit Sub
    End If
     
   '----- 取込確認 -----
    If MsgBox(pbFile & " から取込します。" & vbCr & vbCr & "よろしいですか?", vbOKCancel + vbQuestion, "取込確認") = vbCancel Then
        DoCmd.Hourglass False
        Exit Sub
    End If
     
    '----- 出力テーブルのクリア -----
    DoCmd.SetWarnings False 'メッセージの非表示
    DoCmd.RunSQL "DELETE * from tbl_取込データ;"
    DoCmd.SetWarnings True 'メッセージの表示
     
    '----- 出力テーブルを開く -----
    Set DB = CurrentProject.Connection
    RS1.Open "tbl_取込データ", DB, adOpenKeyset, adLockOptimistic
 
    '----- CSVファイルを開く -----
    FNo = FreeFile
    Open pbFile For Input As #FNo
         
    '----- 1件ずつ最後まで読み込む -----
    Do While Not EOF(FNo)
     
        Line Input #FNo, txtData 'CSVファイルより1件分を読み込み
        arrData = Split(txtData, ",") 'カンマで区切って配列に代入
        lngINPUT_CNT = lngINPUT_CNT + 1 '読取件数カウント
          
        '出力テーブルに追加
        RS1.AddNew
 
        If Left(Replace(arrData(0), """", ""), 1) = "再" Then
                '再試験のデータ("再3_2")
                RS1!時間帯 = Mid(Replace(arrData(0), """", ""), 1, 2)
                RS1!号機 = Mid(Replace(arrData(0), """", ""), 4, 1)
            Else
                '再試験以外のデータ("3_2")
                RS1!時間帯 = Left(Replace(arrData(0), """", ""), 1)
                RS1!号機 = Mid(Replace(arrData(0), """", ""), 3, 1)
        End If
         
        '直径の取得
        If Not IsNumeric(Replace(arrData(1), """", "")) Then
            DoCmd.Hourglass False
            MsgBox (CStr(lngINPUT_CNT) & "行目の2項目目:直径が数値ではありません。" & vbCr & "CSVファイルを確認してください!!")
            GoTo EXIT_SUB       '★ここから「EXIT_SUB」にとんだ時、CLOSEできません。★
        End If
        RS1!直径 = CDbl(Replace(arrData(1), """", ""))
         
        RS1.Update
                 
     Loop
          
    DoCmd.Hourglass False
    MsgBox ("取込が完了しました!!")
     
EXIT_SUB:
 
    '----- CSVファイルを閉じる -----
    Close #FNo
             
    If RS1.State = adStateOpen Then
        RS1.Close               '★ここでエラーになります。★
    End If
    If DB.State = adStateOpen Then
        DB.Close
    End If
    Set RS1 = Nothing
    Set DB = Nothing
     
    Exit Sub
     
Err:
    DoCmd.Hourglass False
    MsgBox "結果取込時にエラーが発生しました!!" & vbCr & vbCr & _
          "エラー番号:" & Err.Number & vbCr & vbCr & _
          "エラー内容:" & Err.Description, vbOKOnly, "【結果取込時】"
    GoTo EXIT_SUB
     
End Sub

回答
投稿日時: 20/06/17 14:44:50
投稿者: sk

引用:
読み込んだデータのチェックをして、異常があれば処理を終了したいのですが、
終了のステップでレコードセットを閉じるときに、以下のエラーが出ます。
このコンテキストで操作は許可されていません。

引用:
Dim RS1 As New ADODB.Recordset

引用:
RS1.Open "tbl_取込データ", DB, adOpenKeyset, adLockOptimistic

引用:
RS1.AddNew

引用:
GoTo EXIT_SUB       '★ここから「EXIT_SUB」にとんだ時、CLOSEできません。★

引用:
If RS1.State = adStateOpen Then
    RS1.Close               '★ここでエラーになります。★
End If

即時更新モードでカレントレコードの編集を行なっている最中に
Close メソッドを呼び出しているからです。
 
Close メソッドより先に、Update メソッドか CancelUpdate メソッドを
呼び出すようにして下さい。
(今回のケースなら後者)

投稿日時: 20/06/22 16:31:45
投稿者: 7986

skさん
回答いただきありがとうございました。
返信が遅くなりすいません。
 
普段、トランザクション処理がほとんどで、ROLLBACKは意識してたのですが...
 CancelUpdate をしなくてもいい、更新モードはあるのでしょうか?
みなさんエラー処理はどのように記述しているのでしょうか。

回答
投稿日時: 20/06/22 17:13:39
投稿者: sk

引用:
Dim DB As New ADODB.Connection

引用:
Set DB = CurrentProject.Connection

引用:
普段、トランザクション処理がほとんどで、ROLLBACKは意識してたのですが...

そのプロシージャ上において、変数 DB のトランザクション系の
メソッド( BeginTrans, RollbackTrans, CommitTrans )は
全く呼び出されていません。
 
引用:
RS1.Open "tbl_取込データ", DB, adOpenKeyset, adLockOptimistic

かつ、RS1 は即時更新モードで開かれています。
 
引用:
CancelUpdate をしなくてもいい、更新モードはあるのでしょうか?

バッチ更新モードというのがあるにはありますが、
このケースの場合は普通に CancelUpdate メソッドを
呼び出してやればよいでしょう。
 
また、とにかくその処理を終了させたいのであれば、
そのエラー自体を無視するようにしても大きな影響はないはず。
 
引用:
EXIT_SUB:
  
    '----- CSVファイルを閉じる -----
    Close #FNo
              
    If RS1.State = adStateOpen Then
        RS1.Close               '★ここでエラーになります。★
    End If

EXIT_SUB:
On Error Resume Next
  
    '----- CSVファイルを閉じる -----
    Close #FNo
 
    If RS1.State = adStateOpen Then
        Select Case RS1.EditMode
            Case adEditAdd, adEditInProgress
                RS1.CancelUpdate
                'バッチ更新モードの場合は CancelBatch メソッドを呼び出すが、
                '呼び出さなくても Close は出来る
            Case Else
                '何もしない
        End Select
        RS1.Close
    End If

トピックに返信