質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.49%
CSV

CSV(Comma-Separated Values)はコンマで区切られた明白なテキスト値のリストです。もしくは、そのフォーマットでひとつ以上のリストを含むファイルを指します。

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Access

Accessはマイクロソフトによるリレーショナルデータベース管理システムです。オブジェクト指向のアプリケーション作成に対応しており、テーブルや編集をはじめ、クエリ生成、入力フォーム作成、レポート作成など一通りの機能を備えています。

Q&A

解決済

3回答

644閲覧

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

emplus

総合スコア17

CSV

CSV(Comma-Separated Values)はコンマで区切られた明白なテキスト値のリストです。もしくは、そのフォーマットでひとつ以上のリストを含むファイルを指します。

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Access

Accessはマイクロソフトによるリレーショナルデータベース管理システムです。オブジェクト指向のアプリケーション作成に対応しており、テーブルや編集をはじめ、クエリ生成、入力フォーム作成、レポート作成など一通りの機能を備えています。

2グッド

1クリップ

投稿2024/02/08 03:29

実現したいこと

タイトルのエラーを回避したい。

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

ファイル生成は成功するのですが,なんかうまく終了しないので戦いましたが(もう何十時間もかかって
疲弊)ほんとに分からないです。(泣きたいです)

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

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

エラーメッセージ

error

1実行時エラー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

試したこと・調べたこと

  • teratailやGoogle等で検索した
  • ソースコードを自分なりに変更した
  • 知人に聞いた
  • その他
上記の詳細・結果

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

補足

特になし

tatsu99👍を押しています

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

sk.exe

2024/02/08 06:42

> ' グループ化するフィールド名 > groupField = "GroupName" フィールド[GroupName]のデータ型を明記されることをお奨めします。
emplus

2024/02/08 07:31

ですよね,フィールド[GroupName]のデータ型がわかってません.... 文字列だとは思いますが,コピペなもので.... すみません...
sk.exe

2024/02/08 07:40

> フィールド[GroupName]のデータ型がわかってません Access 上でテーブル[YourTable]をデザインビューで開いて確認なされば判るかと思います。 > ' グループごとにファイルを作成してデータを書き込む > Dim groupValue As String > groupValue = rs.Fields(groupField).Value 少なくとも、もしフィールド[GroupName]の値が Null であるレコードがテーブル[YourTable]に1件以上存在した場合、そのレコードの[GroupName]の値( Null )を String 型の変数 groupValue に代入しようとすれば、実行時エラー 94 が発生することになるでしょう。
emplus

2024/02/08 08:02

ありがとうございます。 短いテキスト型,つまりはStrings型です。 なるほど,代入しようとしたって型が違いますよ,ということですね。
emplus

2024/02/08 08:08

Do While Not rs.EOF And rs.Fields(groupField).Value = groupValue を Do While Not rs.EOF 'And rs.Fields(groupField).Value = groupValue にしたら ファイル化はされました! でもグループごとでなくなりました.......................................... chat gpt君がソース吐き出したときは感激したんですが...
guest

回答3

0

ベストアンサー

VBA

1 ' グループごとのデータを書き込む 2 Do While Not rs.EOF And rs.Fields(groupField).Value = groupValue 3 Print #1, rs.Fields("Field1").Value & ", " & rs.Fields("Field2").Value & ", " & rs.Fields("Field3").Value ' データ行を書き込む(フィールド名を適切なものに変更してください) 4 rs.MoveNext 5 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

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

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

投稿2024/02/08 14:32

編集2024/02/08 14:55
xail2222

総合スコア1497

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

emplus

2024/02/09 00:14

>rs.EOFがTrueの時は、もうレコードの終わりに来ているのでrs.Fields(groupField)にアクセスしようと うぁ,なるほどそういうことだったのですか! ご指摘通り修正したら見事に動きました。 55歳には難しすぎました 有難うございます。
guest

0

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

短いテキスト型

vba

1Sub ExportGroupToCSV() 2 3 Dim outputPath As String 4 5 '出力先フォルダパスの設定 6 outputPath = "C:\Output" 7 8 'フォルダパスの実在チェック 9 If Dir(outputPath, vbDirectory) = "" Then 10 '見つからなければ終了 11 MsgBox "フォルダ""" & outputPath & """が見つかりません。", _ 12 vbExclamation, _ 13 "フォルダ参照エラー" 14 Exit Sub 15 End If 16 17 '末尾にパス区切り文字を追記 18 outputPath = outputPath & "\" 19 20 Dim db As DAO.Database 21 22 'カレントデータベースの参照 23 Set db = CurrentDb 24 25 Dim rsGroup As DAO.Recordset 26 Dim groupField As String 27 Dim sql As String 28 29 'グループ化するフィールドの名前を設定 30 groupField = "GroupName" 31 32 '変数 groupField と同じ名前のフィールドをグループ化した結果 33 '(以下「グループセット」)を得る。 34 'フィールドの値が Null である場合は空文字列として扱う。 35 sql = "SELECT Nz(t1.[" & groupField & "],'') AS [" & groupField & "]" & _ 36 " FROM [YourTable] t1" & _ 37 " GROUP BY Nz(t1.[" & groupField & "],'')" 38 Set rsGroup = db.OpenRecordset(sql, dbOpenSnapshot) 39 40 'レコードが1件も存在しない場合は終了 41 If rsGroup.EOF Then 42 rsGroup.Close 43 Set rsGroup = Nothing 44 Set db = Nothing 45 Exit Sub 46 End If 47 48 Dim qdf As DAO.QueryDef 49 50 ' 一時的なパラメータクエリの作成 51 sql = "PARAMETERS [ItemKey] TEXT(255);" & _ 52 "SELECT t1.[Field1] AS [Header1], t1.[Field2] AS [Header2], t1.[Field3] AS [Header3]" & _ 53 " FROM [YourTable] t1" & _ 54 " WHERE Nz(t1.[" & groupField & "],'')=Nz([ItemKey],'')" 55 Set qdf = db.CreateQueryDef("", sql) 56 57 Dim rsDetail As DAO.Recordset 58 Dim fld As DAO.Field 59 Dim groupValue As String 60 Dim fileName As String 61 Dim headerRow As String 62 Dim dataRow As String 63 64 'グループセットの全てのレコードを読み切るまでループ 65 Do Until rsGroup.EOF 66 67 '現在のグループの値を取得する 68 groupValue = rsGroup.Fields(groupField).Value 69 70 'パラメータクエリを実行し、現在のグループに該当するレコードを抽出した結果 71 '(以下「詳細セット」)を得る 72 With qdf 73 'クエリパラメータへの値渡し 74 .Parameters("ItemKey").Value = groupValue 75 'クエリを実行した結果をレコードセットとして取得する 76 Set rsDetail = .OpenRecordset(dbOpenSnapshot) 77 End With 78 79 '詳細セットの各フィールドの名前から、列見出し行として出力する文字列を生成する。 80 'この処理は1度だけ実行する。 81 If headerRow = "" Then 82 For Each fld In rsDetail.Fields 83 headerRow = headerRow & _ 84 "," & fld.Name 85 Next 86 headerRow = Mid(headerRow, 2) 87 End If 88 89 '現在のグループの値が空文字列である場合 90 If groupValue = "" Then 91 '他のグループと競合しない文字列をファイル名として設定 92 fileName = "グループが不明であるレコード" 93 '現在のグループの値が空文字列ではない場合 94 Else 95 '現在のグループの値をそのままファイル名とする 96 '(厳密には、ファイルパスとして使用できない文字が含まれる可能性があるなら 97 'エスケープ処理を加えた方がよいが、このサンプルでは割愛する) 98 fileName = groupValue 99 End If 100 'ファイル拡張子を追記 101 fileName = fileName & ".csv" 102 103 'ファイル出力の開始 104 Open outputPath & fileName For Output As #1 105 106 '列見出し行の書き込み 107 Print #1, headerRow 108 109 '詳細セットの全てのレコードを読み切るまでループ 110 Do Until rsDetail.EOF 111 112 '詳細セットの各フィールドの値から、データ行として出力する文字列を生成する 113 dataRow = "" 114 For Each fld In rsDetail.Fields 115 dataRow = dataRow & _ 116 "," & Nz(fld.Value, "") 117 Next 118 dataRow = Mid(dataRow, 2) 119 120 'データ行の書き込み 121 Print #1, dataRow 122 123 '詳細セットのカレントレコードを次のレコードに移動 124 rsDetail.MoveNext 125 Loop 126 127 '詳細セットを閉じる 128 rsDetail.Close 129 Set rsDetail = Nothing 130 131 'ファイルを閉じる 132 Close #1 133 134 'グループセットのカレントレコードを次のレコードに移動 135 rsGroup.MoveNext 136 Loop 137 138 'グループセットを閉じる 139 rsGroup.Close 140 Set rsGroup = Nothing 141 142 Set qdf = Nothing 143 Set db = Nothing 144 145End Sub

投稿2024/02/08 08:47

編集2024/02/08 09:23
sk.exe

総合スコア740

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

emplus

2024/02/08 09:04

え!え!なんすかこの美しいソース,,,,
emplus

2024/02/09 00:20

こちらも見事に動きました。 ソースの内容が秀逸で今後大事に利用させてもらいます。 特に詳細セットという考え方がMagicでした。 わざわざ記述頂きありがとうございました。
guest

0

このエラーは、ループがレコードセットの最後に達した後に、次のレコードを取得しようとして発生します。これは、内側のループで 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 の呼び出しは行われなくなり、エラーが解消されるはずです。一度、トライをお願いします

投稿2024/02/08 06:09

shoshinsha123

総合スコア213

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

emplus

2024/02/08 07:44

そうなんですね!でも書き込む場所がわからなくて.... Do While Not rs.EOF And rs.Fields(groupField).Value = groupValue を 「改行キーはきにしないで,groupFieldがあるかぎり,Printせよ って思っていて...(たぶん違う) ご指摘のお話しですと rs.MoveNext の前あたりに IIf rs.EOF = True Then Exit Do などと書いて 見事にエラー。というレベルで本当に申し訳ないです。
emplus

2024/02/08 08:49

chatgpt-Monica様にきいたところ, Do While Not rs.EOF If rs.Fields(groupField).Value = groupValue Then    Print #1 ~省略ご了承~    End If    rs.MoveNext  Loop だというので実行してみたらエラーは消えましたが,ファイルが先頭のグループだけで終わってしまいました。 111,りんご,赤い 222,みかん,黄色い といったデータなのですが, 111.csvでスルッと終わるという...........
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.49%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問