VB テーブルのデータを出荷先ごとにcsv出力

質問

お世話になります。

VBは素人で、自分なりにネットでいろいろ調べて、下記の物を作ってみたのですが、
うまくいかず、とても悩んでおります。
知ってる方、どなたか教えて頂けませんか？
よろしくお願いいたします。ｍ(_ _)ｍ
------------------------------------------------------------------
目的：
(1)テーブルのフィルド名を、各CSVの一行目に出力したい。
(2)テーブルのフィルドは30項目ぐらいあるため、下記のように個別出力ではなく、
　　一括で出力できるようにしたいです。
(3)すべての項目には、”　”で囲み、カンマで区切りをしたいです。
------------------------------------------------------------------
Option Compare Database
Option Explicit

Private objDB As DAO.Database
Private objExcel As Object 'EXCELオブジェクト
Private objWorkBook As Object 'WORKBOOKオブジェクト
Private objSheet As Object 'SHEETオブジェクト

Public Sub CSVsyuturyoku()

Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset

Dim flag As Boolean

Set db = CurrentDb
Set rs1 = db.OpenRecordset("SELECT DISTINCT 氏名 FROM 出荷データ")

Do Until rs1.EOF

Set rs2 = db.OpenRecordset("SELECT * FROM 出荷データ" _
& " WHERE Nz(氏名) = '" & rs1!氏名 & "'")

flag = True

Open CurrentProject.Path & "\ファイル" & rs1!氏名 & ".csv" _
For Output As #1

Do Until rs2.EOF

'Print #1, Nz(rs2!商品名)
Print #1, rs2!商品コード & "," & rs2!商品名 & "," & rs2!単価
' ↑フィルド項目数が多すぎたため、全部書ききらず。。。

rs2.MoveNext

Loop

Close #1
rs1.MoveNext
Loop

rs1.Close: Set rs1 = Nothing
If flag Then rs2.Close: Set rs2 = Nothing
db.Close: Set db = Nothing

' 終了の表示
MsgBox "ファイル出力が完了しました。"

End Sub

回答No.4

imogasi

＃１です。
エクセルＶＢＡで、ＡＤＯでやってみました。興味があればやってみてください。
（最近のアクセスは、ＤＡＯが標準とは信じがたいのでＡＤＯにしました）
たまにしかやらないため、色んなところで苦労しましたが、コードにコメントを入れてみました。
例データ　
エクセルのｂｕｋｋｕブックの「計数例A」の.シートＳｈｅｅｔ１
会社名 地区 計数１ 計数２
ＡＡ 東京 213 1
ＡＡ 福岡 456 1
ＡＡ 神戸 112 4
ＡＡ 東京 279 1
ＢＢ 東京 279 1
ＢＢ 東京 555 1
ＢＢ 大阪 234 2
ＣＣ 東京 279 1
ＣＣ 大阪 224 1
ＣＣ 広島 666 1
ＣＣ 名古屋 567 3
ＣＣ 東京 279 1
標準モジュールに
Sub test01()
Open "変換1.csv" For Output As #1
'実行ーリセット―ツールー参照設定ー
'Ｍicrosoft ActiveX Data Objects 2.8 Libraryにチェックを入れること
'データのあるエクセルブック（下記では計数例A.xlsx）を開いておくこと
'開いてないと「外部フォーマットが正しくありません」とでる。
'第1行目が見出しかどうかHDR=YESの部分に注意
Dim oConn As New ADODB.Connection 'ActiveX・・の参照設定がないと、この行でエラーとなる
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Users\XXXX\Documents\計数例A.xlsx;" & _
"Extended Properties=""Excel 8.0;HDR=YES;"""
'rovider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\users\ken3_org\Cgi-bin\test\test056.xls;Extended Properties=Excel 8.0
Set dbRes = New ADODB.Recordset
dbRes.Open "Select * from [Sheet1$] ORDER by 会社名", oConn, adOpenStatic 'これが必要　oConn.Openと合わせること
'計数例A.xlsxの第1行には見出し会社名 地区 計数１ 計数２のように会社名が必要
'見出しがないと「１つ以上のパラメータが必要」とエラーになる
'Set dbRes = New ADODB.Recordset
' dbRes.CursorLocation = adUseClient
' dbRes.Open strSQL, dbCon, adOpenDynamic, adLockOptimistic, adCmdText
'受け入れる側のシートクリア
Worksheets("Sheet2").Cells.ClearContents
'---------------------------------------------------------------------------
' 見出し作成(普通は要らない！) HDR=YESのとき
For COL = 1 To dbRes.Fields.Count
Cells(1, COL).Value = dbRes.Fields(COL - 1).Name
Next COL

'---------------------------------------------------------------------------
' 明細のセット
'Cells(1, 1).CopyFromRecordset dbRes ' ←単純に全件転記ならこの記述でOK!
'Exit Sub
fn = dbRes.Fields.Count
Do Until dbRes.EOF
For COL = 1 To dbRes.Fields.Count - 1
Write #1, CStr(dbRes.Fields(COL - 1).Value);
Next COL
Write #1, CStr(dbRes.Fields(fn - 1).Value) '1つ少ないインデックス
dbRes.MoveNext
Loop

'---次行の処理のため現在の行のデータを受け渡す
'--最終行の処理を終りクローズ
' 終了
Close #1 'アウトプットファイルクローズ
dbRes.Close: Set dbRes = Nothing 'Set dbRes = と合わせること
oConn.Close: Set dbCon = Nothing '上のDim oConnと合わせること
End Sub
ーーー
結果　ＣＳＶファイル　変換１.CSV
"ＡＡ","東京","279","1"
"ＡＡ","神戸","112","4"
"ＡＡ","福岡","456","1"
"ＡＡ","東京","213","1"
"ＢＢ","大阪","234","2"
"ＢＢ","東京","555","1"
"ＢＢ","東京","279","1"
"ＣＣ","東京","279","1"
"ＣＣ","名古屋","567","3"
"ＣＣ","広島","666","1"
"ＣＣ","大阪","224","1"
"ＣＣ","東京","279","1"
数字項目にも””で囲むとか、最後のフィールド項目にカンマが残らないようにするとか、で苦労した。
この点は上記コードが参考になるでしょう。（数字項目には、””で囲まない形式もよく使われる。）
ーー
それと時間がなくて、「出荷先ごとにcsv出力 」するためのコードが組み込めていません。
データは「会社名」の列でＳＱＬで、ソート済みなので、直前レコードと比べて、会社名が変わったら、現在のＣＳＶファイルをＣｌｏｓｅして、別名のＣＳＶファイルをＯｐｅｎして書き出すように修正してください。

回答No.3

okgoo3

そっか、最近の Access って ADO じゃなくて DAO が既定で参照設定されてるんだよね。
以下は Access 2010 で試してみました。

手っ取り早く CSV を出力するならば DoCmd.TransferText でいいと思います。
DoCmd.TransferText acExportDelim, , [テーブルまたはクエリ名], [出力ファイル名], True
ただし [テーブルまたはクエリ名] の部分は実在するテーブルやクエリの名前を指定する必要があるって点が大きな課題。
もしプログラムの中で一時的にクエリを作成してしまっても構わないのなら QueryDef を使って処理ができます。
作ってしまったクエリは最後に削除すればいいし。

SQL 文字列を直接こねくるのは、検索条件に変な値があった時に危険だから好きじゃないんだけど、今回はとりあえず他人事だと思って簡単に。

' 一時的にクエリを作成
Dim qdfExport As DAO.QueryDef
Set qdfExport = CurrentDB.CreateQueryDef("qCSV出力")

' クエリの中身 の SQL 文。
' 長くなるけどここだけ頑張る。
' すべてのフィールドを Nz 関数で文字列型に強制変換しつつ、フィールド名が正しく出力されるよう AS を使用。
' 抽出条件になる氏名の値はあとで置換しやすい文字にしておく。
Dim exportSql As String
exportSql = "SELECT Nz([出荷データ].[商品コード],'') AS 商品コード, Nz([出荷データ].[商品名],'') AS 商品名, Nz([出荷データ].[単価],'') AS 単価 ・・・ WHERE Nz([出荷データ].[氏名],'') = '@@@@'")

Dim rstPersons As DAO.Recordset
Set rstPersons = CurrentDB.OpenRecordset("SELECT DISTINCT 氏名 FROM 出荷データ")
Do Until rstPersons.EOF
　　' クエリの SQL に検索条件の氏名を埋め込む
　　qdfExport.Sql = Replace(exportSql, "@@@@", rstPersons.Fields("氏名").Value)
　　DoCmd.TransferText acExportDelim, , qdfExport.Name, CurrentProject.Path & "\ファイル" & rstPersons.Fields("氏名").Value & ".csv", True
　　rstPersons.MoveNext
Loop

rstPersons.Close
CurrentDB.QueryDefs.Delete qdfExport.Name

回答No.2

NotFound404

AccessのVBAかな？？、開発環境のソフト名とバージョンが不明なので
AccessVBAと仮定してのヒントだけです。
（次回からは必ず明記を！）

FF1　FF2　　　　　　FF3　　　　　FF4　　FF5
1　　　　　　　　　2000/04/28　　1234　　1-1
2　　にほへと　　　2000/02/29　　100　　1-2
3　　ちりぬるを　　2000/03/01　　0　　　1-3
という『出荷データ』があったとして

Sub Hint()
Dim db As DAO.Database
Dim rs1 As DAO.Recordset

'Dim flag As Boolean
Dim i As Long, Buf As Variant

Set db = CurrentDb
Set rs1 = db.OpenRecordset("SELECT * FROM 出荷データ")

DoCmd.RunCommand acCmdDebugWindow

'フィールド名取得
Buf = """"
For i = 0 To rs1.Fields.Count - 1
　　Buf = Buf & rs1.Fields(i).Name & ""","""
Next
Buf = Left(Buf, Len(Buf) - 2)
Debug.Print Buf

Stop '確認用休止
'各レコードの値取得
Do Until rs1.EOF
　　Buf = """"
　　For i = 0 To rs1.Fields.Count - 1
　　　　Buf = Buf & rs1.Fields(i).Value & ""","""
　　Next
　　Buf = Left(Buf, Len(Buf) - 2)
　　Debug.Print Buf
　　rs1.MoveNext
Loop
End Sub

を実行すると
"FF1","FF2","FF3","FF4","FF5"
"1","","2000/04/28","1234","1-1"
"2","にほへと","2000/02/29","100","1-2"
"3","ちりぬるを","2000/03/01","0","1-3"
がイミディエイトウィンドウに出力されます。
投稿用にタブインデントの代わりに全角スペースを代用しています。

回答No.1

imogasi

・どこが、どううまく行かないのか書かない質問者が多い。書くべきでしょう。
・目的を書くこと。ＣＳＶファイルを作ったあと、どうしたいのか。ＣＳＶファイルは別のアプリへの中継ぎデータに使われることが多いようで、それそのものは使い道はないだろう。
これを認識してＣＳＶファイルを検討しないと１分で不都合が起こるかも。
・元データは、エクセルのブックの処理のようだが、エクセルＶＢＡを勉強して使うほうがＷＥＢや解説本に情報が多いと思う。ＳＱＬなどの勉強も必要だろうし。
なぜ初心者といっておいて、ＤＡＯなのか不思議。今では使われるのはＡＤＯが多いとかお思うが。
・独学にはいろいろ注意が必要と思う。視野が偏る恐れが多い。思いつきの変な方法でやってしまう恐れもある。
・””で項目を囲むＣＳＶファイルのタイプを勉強し、次に読み込ませるアプリで正確に読み込める方式を見極める必要がある。
・ＣＳＶファイルには（そのほかにＴＳＶ，ＳＳＶもあるが）
　　ダブルクオートなし
　　数値のみダブル句オートなし
　　全項目ダブルクオート
など、歴史的に各種あり、その最後のタイプでよいのですね。
そのほかに、文字コードなどの問題もある。
ーー
載りかけた船（ＤＡＯ）を変えるのはむつかしいだろうが、エクセルＶＢＡでやってみた。参考にする気があれば読んでみて。
データのあるエクセルブックの標準モジュールに
Sub test01()
n = 1 'ファイル番号の初期値を１とする
Open "変換1.csv" For Output As #1
Worksheets("Sheet1").Range("Ａ1").Select
Range("A1").CurrentRegion.Select
Selection.Offset(1, 0).Select
Selection.Resize(Selection.Rows.Count - 1).Select
’社名・氏名でソート
Selection.Sort Key1:=Worksheets("Sheet1").Range("A1"), order1:=xlAscending, Key2:=Worksheets("Sheet1").Range("A2"), order1:=xlAscending
'--
'For Each r In Selection.Rows
'If Range("A" & r.Row) <> m Then
'MsgBox Range("A" & r.Row)
'm = Range("A" & r.Row)
'---
l = Range("A100000").End(xlUp).Row
'MsgBox l
c = Cells(2, 1000).End(xlToLeft).Column
'MsgBox c
'---順次処理のキー
m1 = Range("A" & 2)
m2 = Range("B" & 1)
For i = 2 To l
MsgBox Range("A" & i) & i
If Range("A" & i) <> m1 Then
'--会社が変わったら＜－－
Close #1
n = n + 1
fn = "変換" & n 'アウトプットファイル（名）を変える
MsgBox fn
Open fn & ".csv" For Output As #1 '新しいcsvファイルを開く
End If
'---レコード（シート各行)処理
If Range("B" & i) <> m2 Then '前行と同じ氏名ならスキップ
'--SQLのDistinct処理に当たる
For j = 1 To c
If j = c Then
Write #1, Cells(i, j)
Else
' Print #1, Cells(i, j);
Write #1, Cells(i, j); '全項目が””付きになる
End If
Next j
' Print #1,
End If
'---次行の処理のため現在の行のデータを受け渡す
m1 = Range("A" & i)
m2 = Range("B" & i)
Next i
'--最終行の処理を終りクローズ
Close #1
End Sub
ーー
例データ
Ｓｈｅｅｔ１のＡ１：Ｅ１８
元は社名出現の順序バラバラだが、ソート語を掲示
社名 氏名 点数1 点数2 項目１
Ａ社 上野 41 41 abc
Ａ社 榎井 36 41 sdfg
Ａ社 小野 67 41 gh
Ａ社 木村 42 41 hj234
Ａ社 田中 41 41 wq345
Ｂ社 上野 42 41 as
Ｂ社 木村 45 41 fr345
Ｂ社 近藤 67 41 we2356
Ｂ社 戸田 41 41 x3456
Ｂ社 花村 35 41 we2356
C社 根来 36 37 we2357
C社 金村 37 33 we23572
C社 石井 38 29 we2358
C社 大下 39 25 we23582
C社 野村 40 21 we2359
C社 宮野 41 17 we23592
C社 文野 42 13 we2360
’－－
結果（一部のＢ社分掲載）ファイル名 変換2.csv
"Ｂ社","上野","42","41","as"
"Ｂ社","木村","45","41","fr345"
"Ｂ社","近藤","67","41","we2356"
"Ｂ社","戸田","41","41","x3456"
"Ｂ社","花村","35","41","we2356"
本件では、Ｗｒｉｔｅ＃は便利だが、本件ではむつかしい面もあった。
元データが、多シートや多ブックがあると、ＶＢＡを相当勉強しないと、上記を加筆・修正の手を加えられないだろうな。