レコードセットを最初に作ります。
sql="select distinct ID * from table order by ID"
rs=openrecordset(sql)
これでrsを作りました。
続いてループでまわします。そして別のレコードセットを作ります。
Do until rs.eof
sqlnext="select * from table where ID=" & rs!ID
set rs2=nothing
rs2.openrecordset(sqlnext)
Do until rs2.eof
Excelに書き込み作業
rs2.movenext
loop
excelに保存作業
rs.movenext
loop
という回りくどいやり方でexcelへ保存作業を行っております。例えばIDが1,1,2,2,2,3,3,3とあった場合、1は１の塊で出力、2は2の塊で出力、3は3の塊で出力して保存したいと思っています。この例だと3ファイルできるはずです。3ファイルは作ることができました。しかし、1のファイルを見ると、1のIDだけをひっぱってきているので問題ない。2のファイルを見るとIDが１と2のファイルを持ってきている、×。3つ目のファイル。IDが１，２、３のIDを引っ張ってきている。ダメ。という具合に上手に塊で出力することができません。どこが悪いのでしょうか？
No.1
1314
393
400pt
コードの全体が見えていないので何とも言えませんが、クエリの処理よりEXCELのデータ出力処理の
部分の問題であるような気がします。
下記は同様の処理をファイル別に出力した例ですが、こちらの試験の範囲ではデータの重複なく出力
できました。
実際の EXCEL への出力の部分を提示いただければ具体的な回答ができるかと思います。
Option Explicit Sub dataDistributer() Dim wb As Workbook 'テーブルの名前を指定 Const tableName As String = "テーブル1" Dim res1 As DAO.Recordset Dim res2 As DAO.Recordset Set res1 = query("SELECT DISTINCT ID FROM " & tableName & " ORDER BY ID") Dim r As Long, c As Long Do While res1.EOF = False Set res2 = query("SELECT * FROM " & tableName & " WHERE ID = " & res1.Fields(0).Value) Set wb = Workbooks.Add() r = 0 Do While res2.EOF = False r = r + 1 For c = 0 To res2.Fields.Count - 1 wb.Worksheets(1).Cells(r, c + 1).Value = res2.Fields(c).Value Next res2.MoveNext Loop wb.SaveAs ThisWorkbook.Path & "\" & res1.Fields(0).Value & ".xls" res1.MoveNext Loop End Sub Function query(sql As String) As DAO.Recordset 'Accessのファイルのパスを指定 Const mySource = "C:\Database\myDB.mdb" Dim db As DAO.Database Set db = DBEngine.Workspaces(0).OpenDatabase(mySource) Set query = db.OpenRecordset(sql) Set db = Nothing End Function
http://www.happy2-island.com/access/gogo03/capter00207.shtml
No.1
1314393
ここでベストアンサー
400pt
コードの全体が見えていないので何とも言えませんが、クエリの処理よりEXCELのデータ出力処理の
部分の問題であるような気がします。
下記は同様の処理をファイル別に出力した例ですが、こちらの試験の範囲ではデータの重複なく出力
できました。
実際の EXCEL への出力の部分を提示いただければ具体的な回答ができるかと思います。
Option Explicit Sub dataDistributer() Dim wb As Workbook 'テーブルの名前を指定 Const tableName As String = "テーブル1" Dim res1 As DAO.Recordset Dim res2 As DAO.Recordset Set res1 = query("SELECT DISTINCT ID FROM " & tableName & " ORDER BY ID") Dim r As Long, c As Long Do While res1.EOF = False Set res2 = query("SELECT * FROM " & tableName & " WHERE ID = " & res1.Fields(0).Value) Set wb = Workbooks.Add() r = 0 Do While res2.EOF = False r = r + 1 For c = 0 To res2.Fields.Count - 1 wb.Worksheets(1).Cells(r, c + 1).Value = res2.Fields(c).Value Next res2.MoveNext Loop wb.SaveAs ThisWorkbook.Path & "\" & res1.Fields(0).Value & ".xls" res1.MoveNext Loop End Sub Function query(sql As String) As DAO.Recordset 'Accessのファイルのパスを指定 Const mySource = "C:\Database\myDB.mdb" Dim db As DAO.Database Set db = DBEngine.Workspaces(0).OpenDatabase(mySource) Set query = db.OpenRecordset(sql) Set db = Nothing End Function
http://www.happy2-island.com/access/gogo03/capter00207.shtml
ご回答ありがとうございます。excelへの書き込み作業の部分は、
Cells(row, col).Value = rs2!ID
Cells(row, col).Value = rs2!NAME
Dim x as string
x=rs2!ID
.....
とレコードセット2の値をcells関数で指定して保存しています。
続きまして、rs.movenextでrs2のレコードセットが空になったら、Pathで出力先フォルダを決めて、
filename=Path & x
wb.saveas filename
これで保存します。そして、
rs.movenextで最初の行に戻ります。具体性に欠けるかも知れませんが、よろしくお願いいたします。
No.2
1314393
先の回答で言い忘れましたが、コメントを有効にしていただけると対応がしやすいです。
肝心な部分が書かれていないので何とも言えませんが、ファイルの扱いはどのようになっているでしょうか。
186
163
Do While rs1.EOF = False
Set rs2 = ・・・・・
'★★★★ここに wb を新規で作成する（もしくは初期化する）処理が必要
Do While rs2.EOF = False
セルの書き込み処理
row = row+1
Loop
filename=Path & x
wb.saveas filename
Loop
のような構造だと、追記して上書き処理なので質問された現象になるかと思います。
これにファイルの作成処理は先の回答で行っているのでご参考ください。
Set wb = Workbooks.Add()
の部分です。
わかりにくくて申し訳ありません。下記に再度書いてみました。
テーブルはanimalでフィールド名にID、カテゴリ、種類とあります。ID=1,1,2,2,3... カテゴリ犬、犬、猫、猫、鳥... 種類=マルチーズ、秋田犬、ペルシャ猫、雑種猫、フクロウ
というデータがあります。
Dim rs1 as dao.recordset, Dim rs2 as dao.recordset Dim st1 as string,Dim st2 as string dim row as int=0 Dim output as string Dim path as string
Set apx = CreateObject("Excel.Application")
Set wb = xl.Workbooks.Add
Set ws = x.Worksheets(1)
st1="select distinct ID from animal order by animal"
set rs1=openrecordset(st1,dbopendynaset)
Do until rs1.eof
st2="select ID,カテゴリ、種類 where ID='" & rs1!ID & "'"
set rs2=nothing rs2=openrecordset(st2,dbopendynaset)
Do until rs2.eof
row =row+1
cells(row,１).value=rs2!ID
cells(row,２).value=rs2!カテゴリ
cells(row,３).value=rs2!種類
dim x as string x=rs2!ID
rs2.movenext
loop
path="C:\"
output = path & x & "xls"
web.saveas output
rs1.movenext
loop
msgbox "end"
といった感じになります。
Mook
2009/02/22 12:31:45
2
akaired
ご回答ありがとうございます。excelへの書き込み作業の部分は、
Cells(row, col).Value = rs2!ID
Cells(row, col).Value = rs2!NAME
Dim x as string
x=rs2!ID
.....
とレコードセット2の値をcells関数で指定して保存しています。
続きまして、rs.movenextでrs2のレコードセットが空になったら、Pathで出力先フォルダを決めて、
filename=Path & x
wb.saveas filename
これで保存します。そして、
rs.movenextで最初の行に戻ります。具体性に欠けるかも知れませんが、よろしくお願いいたします。