Microsoft Access 掲示板

Microsoft Access 掲示板

レコードセットのエクセルへの出力と保存

4 コメント
views
4 フォロー

お世話になっております。

やりたいことは、「クエリで抽出したIDごとに別のエクセルブックに保存したい」です。
以下は自分で作ってみたのですが、ここからどうしていいのかわかりません。
そもそも自作コードの考え方がおかしければ修正いただけないでしょうか。
よろしくお願いいたします。

for i = 1 to 10
   strSQL = "SELECT [T台帳].* "
   strSQL = strSQL & "FROM [T台帳] "
   strSQL = strSQL & "WHERE ((([T台帳].ID)="
   strSQL = strSQL & i & "));"
   Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

   Set xls = CreateObject("Excel.Application")
   With xls
       .workbooks.Add
       For j = 0 To rs.Fields.Count - 1
           .cells(1, j + 1) = rs(j).Name
       Next j
       .cells(2, 1).copyfromrecordset rs
       .Visible = True

' ここでできたエクセルを、名前を自動でつけて(id名でよい)、指定のパスに保存したい

   End With
   Set xls = Nothing
Next i
nokonoko
作成: 2023/06/08 (木) 09:41:52
通報 ...
1
hiroton 2023/06/08 (木) 11:26:50 修正 dd05a@f966d

id名を取得しておいて、保存はExcel VBAでの記述をそのまま使えばいいですね

       Dim id名 As String
       For j = 0 To rs.Fields.Count - 1
           .cells(1, j + 1) = rs(j).Name
           If rs(j).Name = "id名" Then id名 = rs(j)
       Next j
       .cells(2, 1).copyfromrecordset rs
       .Visible = True

'// ここでできたエクセルを、名前を自動でつけて(id名でよい)、指定のパスに保存したい
  .ActiveWorkbook.SaveAs "(指定のフォルダパス)" & "\" & id名

コード全体に関しては
ループ内でやるべき（何度も繰り返す必要がある）処理か？
With ～ End With内の省略記述は正しくオブジェクトが指定できているか？
あたりを見つめてみるといいと思います

コードミスを見落としてました
openに対してcloseがないですね

   Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)  '//これに対応するcloseがない

なくても動くといえば動くんですが（たいていエラーも起きないでしょう）だいぶ良くないので指摘しておきます

2
nokonoko 2023/06/08 (木) 13:45:03 3e2e6@54883

回答ありがとうございます。
やりたいことができるようになりました。
しかし、このあたりのコードをまだいじっている途中なので、またこの続きに質問することがあるかもしれません。その時は、お時間がありましたら、よろしくお願いします

コードミスを見落としてました
openに対してcloseがないですね

ご指摘ありがとうございます。エラートラップのほうにまぎれて入っていました。

3
nokonoko 2023/06/08 (木) 17:02:54 3e2e6@54883

今回はありがとうございました。
予定通りの作業ができるようになりました。

4
hiroton 2023/06/10 (土) 08:00:56 0c5d8@2ee8f

補足
id名変数を作らなくても、端に

'// ここでできたエクセルを、名前を自動でつけて(id名でよい)、指定のパスに保存したい
  .ActiveWorkbook.SaveAs "(指定のフォルダパス)" & "\" & rs!id名

  rs.close

で、動くと思われます
変数に置くメリットとしては、rsのopen時間を減らす、ファイルの存在チェック（ファイル名の変更）ができるようになるなどです

       For j = 0 To rs.Fields.Count - 1
           If rs(j).Name = "id名" Then id名 = rs(j)
       Next j

書き出しなのでフィールドの存在チェックは不要でした

       Dim id名 As String
       id名 = rs!id名
       For j = 0 To rs.Fields.Count - 1
           .cells(1, j + 1) = rs(j).Name
       Next j
       .cells(2, 1).copyfromrecordset rs
       .Visible = True
       rs.close

'// ここでできたエクセルを、名前を自動でつけて(id名でよい)、指定のパスに保存したい
  .ActiveWorkbook.SaveAs "(指定のフォルダパス)" & "\" & id名