access vba グループごとにCSVファイルを作成で「実行時エラー3021　カレントレコードがありません」

Question

### 実現したいこと
タイトルのエラーを回避したい。

### 発生している問題・分からないこと
ファイル生成は成功するのですが，なんかうまく終了しないので戦いましたが（もう何十時間もかかって
疲弊）ほんとに分からないです。（泣きたいです）

groupField　がなくなったら，という処理がないような気がします。
なのでgroupFieldの空の行を掴んでエラーしている印象なのです。

現在は　On Error GoTo myError　で無理やり終了させてます..............

### エラーメッセージ
```error
実行時エラー3021　カレントレコードがありません
```

### 該当のソースコード

```
Sub ExportGroupToCSV()
    Dim rs As DAO.Recordset
    Dim groupField As String
    Dim outputPath As String
    Dim sql As String
    Dim qdf As QueryDef
    
    ' グループ化するフィールド名
    groupField = "GroupName"
    
    ' 出力先のフォルダパス
    outputPath = "C:\Output\"  ' 出力先のフォルダを適切なパスに変更してください
    
    ' クエリのSQL文を構築
    sql = "SELECT * FROM YourTable ORDER BY " & groupField
    
    ' クエリを作成
    Set qdf = CurrentDb.CreateQueryDef("", sql)
    
    ' レコードセットを取得
    Set rs = qdf.OpenRecordset
    
    ' レコードセットをグループ単位で処理
    Do While Not rs.EOF
        ' グループごとにファイルを作成してデータを書き込む
        Dim groupValue As String
        groupValue = rs.Fields(groupField).Value
        
        ' CSVファイルに書き込む
        Open outputPath & groupValue & ".csv" For Output As #1
        Print #1, "Header1, Header2, Header3"  ' ヘッダー行を書き込む（適切なヘッダー名に変更してください）->不要
        
        ' グループごとのデータを書き込む
        Do While Not rs.EOF And rs.Fields(groupField).Value = groupValue
            Print #1, rs.Fields("Field1").Value & ", " & rs.Fields("Field2").Value & ", " & rs.Fields("Field3").Value  ' データ行を書き込む（フィールド名を適切なものに変更してください）
            rs.MoveNext
        Loop
        
        ' ファイルを閉じる
        Close #1
    Loop
    
    ' レコードセットとクエリを解放
    rs.Close
    Set rs = Nothing
    Set qdf = Nothing
End Sub
```

### 試したこと・調べたこと
- [x] teratailやGoogle等で検索した
- [x] ソースコードを自分なりに変更した
- [ ] 知人に聞いた
- [ ] その他

##### 上記の詳細・結果
グループごとにいったんテーブルに入れてcsv出力したりしましたが，
あとちょっとなのでこのソースがスルッと終われるならこれを使いたいです。

### 補足
特になし

Accepted Answer

```VBA
        ' グループごとのデータを書き込む
        Do While Not rs.EOF And rs.Fields(groupField).Value = groupValue
            Print #1, rs.Fields("Field1").Value & ", " & rs.Fields("Field2").Value & ", " & rs.Fields("Field3").Value  ' データ行を書き込む（フィールド名を適切なものに変更してください）
            rs.MoveNext
        Loop        
```
「Not rs.EOF And rs.Fields(groupField).Value = groupValue」この部分ですが
VBAでは、rs.EOFがTrueの時も「rs.Fields(groupField).Value = groupValue」がチェックされます。

rs.EOFがTrueの時は、もうレコードの終わりに来ているのでrs.Fields(groupField)にアクセスしようとして
3021番のエラーが出ます。

エラーの原因は、この通りです。
修正するには以下のようにする必要があります。

```VBA
        Do While Not rs.EOF
            If Not rs.Fields(groupField).Value = groupValue Then
                Exit Do
            End If
            Print #1, rs.Fields("Field1").Value & ", " & rs.Fields("Field2").Value & ", " & rs.Fields("Field3").Value  ' データ行を書き込む（フィールド名を適切なものに変更してください）
            rs.MoveNext
        Loop
```

まぁ。GroupName　にNullがあったら、別の理由でエラーになりますが
今回の件は、これで解決するのではないかと思われます。

Answer

> フィールド[GroupName]のデータ型

> 短いテキスト型

```vba
Sub ExportGroupToCSV()
    
    Dim outputPath As String
    
    '出力先フォルダパスの設定
    outputPath = "C:\Output"
    
    'フォルダパスの実在チェック
    If Dir(outputPath, vbDirectory) = "" Then
        '見つからなければ終了
        MsgBox "フォルダ""" & outputPath & """が見つかりません。", _
               vbExclamation, _
               "フォルダ参照エラー"
        Exit Sub
    End If
    
    '末尾にパス区切り文字を追記
    outputPath = outputPath & "\"
    
    Dim db As DAO.Database
    
    'カレントデータベースの参照
    Set db = CurrentDb
    
    Dim rsGroup As DAO.Recordset
    Dim groupField As String
    Dim sql As String
    
    'グループ化するフィールドの名前を設定
    groupField = "GroupName"
    
    '変数 groupField と同じ名前のフィールドをグループ化した結果
    '（以下「グループセット」）を得る。
    'フィールドの値が Null である場合は空文字列として扱う。
    sql = "SELECT Nz(t1.[" & groupField & "],'') AS [" & groupField & "]" & _
          " FROM [YourTable] t1" & _
          " GROUP BY Nz(t1.[" & groupField & "],'')"
    Set rsGroup = db.OpenRecordset(sql, dbOpenSnapshot)
    
    'レコードが1件も存在しない場合は終了
    If rsGroup.EOF Then
        rsGroup.Close
        Set rsGroup = Nothing
        Set db = Nothing
        Exit Sub
    End If
    
    Dim qdf As DAO.QueryDef
    
    ' 一時的なパラメータクエリの作成
    sql = "PARAMETERS [ItemKey] TEXT(255);" & _
          "SELECT t1.[Field1] AS [Header1], t1.[Field2] AS [Header2], t1.[Field3] AS [Header3]" & _
          " FROM [YourTable] t1" & _
          " WHERE Nz(t1.[" & groupField & "],'')=Nz([ItemKey],'')"
    Set qdf = db.CreateQueryDef("", sql)
    
    Dim rsDetail As DAO.Recordset
    Dim fld As DAO.Field
    Dim groupValue As String
    Dim fileName As String
    Dim headerRow As String
    Dim dataRow As String
    
    'グループセットの全てのレコードを読み切るまでループ
    Do Until rsGroup.EOF
        
        '現在のグループの値を取得する
        groupValue = rsGroup.Fields(groupField).Value
        
        'パラメータクエリを実行し、現在のグループに該当するレコードを抽出した結果
        '（以下「詳細セット」）を得る
        With qdf
            'クエリパラメータへの値渡し
            .Parameters("ItemKey").Value = groupValue
            'クエリを実行した結果をレコードセットとして取得する
            Set rsDetail = .OpenRecordset(dbOpenSnapshot)
        End With
        
        '詳細セットの各フィールドの名前から、列見出し行として出力する文字列を生成する。
        'この処理は1度だけ実行する。
        If headerRow = "" Then
            For Each fld In rsDetail.Fields
                headerRow = headerRow & _
                            "," & fld.Name
            Next
            headerRow = Mid(headerRow, 2)
        End If
           
        '現在のグループの値が空文字列である場合
        If groupValue = "" Then
            '他のグループと競合しない文字列をファイル名として設定
            fileName = "グループが不明であるレコード"
        '現在のグループの値が空文字列ではない場合
        Else
            '現在のグループの値をそのままファイル名とする
            '（厳密には、ファイルパスとして使用できない文字が含まれる可能性があるなら
            'エスケープ処理を加えた方がよいが、このサンプルでは割愛する）
            fileName = groupValue
        End If
        'ファイル拡張子を追記
        fileName = fileName & ".csv"
                
        'ファイル出力の開始
        Open outputPath & fileName For Output As #1
        
        '列見出し行の書き込み
        Print #1, headerRow
        
        '詳細セットの全てのレコードを読み切るまでループ
        Do Until rsDetail.EOF
        
            '詳細セットの各フィールドの値から、データ行として出力する文字列を生成する
            dataRow = ""
            For Each fld In rsDetail.Fields
                dataRow = dataRow & _
                          "," & Nz(fld.Value, "")
            Next
            dataRow = Mid(dataRow, 2)
            
            'データ行の書き込み
            Print #1, dataRow
            
            '詳細セットのカレントレコードを次のレコードに移動
            rsDetail.MoveNext
        Loop
        
        '詳細セットを閉じる
        rsDetail.Close
        Set rsDetail = Nothing
        
        'ファイルを閉じる
        Close #1
        
        'グループセットのカレントレコードを次のレコードに移動
        rsGroup.MoveNext
    Loop
    
    'グループセットを閉じる
    rsGroup.Close
    Set rsGroup = Nothing
    
    Set qdf = Nothing
    Set db = Nothing

End Sub
```

Answer

このエラーは、ループがレコードセットの最後に達した後に、次のレコードを取得しようとして発生します。これは、内側のループで rs.MoveNext を呼び出す前に、EOF (End of File) をチェックすることで解決できると思います。
```ここに言語を入力
Sub ExportGroupToCSV()
    Dim rs As DAO.Recordset
    Dim groupField As String
    Dim outputPath As String
    Dim sql As String
    Dim qdf As QueryDef
    
    ' グループ化するフィールド名
    groupField = "GroupName"
    
    ' 出力先のフォルダパス
    outputPath = "C:\Output\"  ' 出力先のフォルダを適切なパスに変更してください
    
    ' クエリのSQL文を構築
    sql = "SELECT * FROM YourTable ORDER BY " & groupField
    
    ' クエリを作成
    Set qdf = CurrentDb.CreateQueryDef("", sql)
    
    ' レコードセットを取得
    Set rs = qdf.OpenRecordset
    
    ' レコードセットをグループ単位で処理
    Do While Not rs.EOF
        ' グループごとにファイルを作成してデータを書き込む
        Dim groupValue As String
        groupValue = rs.Fields(groupField).Value
        
        ' CSVファイルに書き込む
        Open outputPath & groupValue & ".csv" For Output As #1
        Print #1, "Header1, Header2, Header3"  ' ヘッダー行を書き込む（適切なヘッダー名に変更してください）->不要
        
        ' グループごとのデータを書き込む
        Do While Not rs.EOF And rs.Fields(groupField).Value = groupValue
            Print #1, rs.Fields("Field1").Value & ", " & rs.Fields("Field2").Value & ", " & rs.Fields("Field3").Value  ' データ行を書き込む（フィールド名を適切なものに変更してください）
            rs.MoveNext
        Loop
        
        ' ファイルを閉じる
        Close #1
    Loop
    
    ' レコードセットとクエリを解放
    rs.Close
    Set rs = Nothing
    Set qdf = Nothing
End Sub

```

これにより、ループが最後のレコードに達した後でも、追加の MoveNext の呼び出しは行われなくなり、エラーが解消されるはずです。一度、トライをお願いします

実現したいこと

発生している問題・分からないこと

エラーメッセージ

該当のソースコード

試したこと・調べたこと

上記の詳細・結果

補足

関連した質問