ACCESS VBA 複数グループ毎のPDF化

このQ&Aのポイント
  • ACCESS VBAを使用して、複数のグループ毎にPDF化する方法について教えてください。
  • 具体的には、区分とPOをキーに分けてPDFを作成したいのですが、どのような文を加えれば実現できるでしょうか。
  • 現在は区分毎のPDF化は成功していますが、区分とPOを組み合わせてPDFを作成する方法について教えてください。
回答を見る
  • ベストアンサー

ACCESS VBA 複数グループ毎のPDF化

昨日、グループ毎のPDF化はおかげさまで下記の構文で実行できました。 但しグループキーがテーブルにある"PO”というフィールドもキーにする必要があり、また行き詰ってしまいました。 どのような文を加えれば"区分"と"PO"をキーに分けてPDFを作成できますでしょうか? ご教授頂けましたら幸いです。 <行いたいことの例> 区分|PO|商品コード FZ|123|AAA FZ|123|BBB FZ|456|AAA ※区分は同じでもPOが異なる場合はファイルを分けたい <区分毎のPDF化は成功した構文> Option Compare Database Private Sub 分割PDF() Const TBL_NAME = "Amazon2" Const RPT_NAME = "Amazon for ESKER" Const PDF_PATH = "C:\Users\(アカウント)\" Dim rs As ADODB.Recordset Set rs = New ADODB.Recordset rs.Open "SELECT DISTINCT 区分 FROM Amazon2", CurrentProject.Connection, adOpenStatic, adLockReadOnly Do Until rs.EOF pdfName = rs!区分 DoCmd.OpenReport RPT_NAME, acViewPreview, , "区分 = '" & rs("区分") & "'" DoCmd.OutputTo acOutputReport, RPT_NAME, acFormatPDF, PDF_PATH & pdfName & ".pdf" DoCmd.Close rs.MoveNext Loop End Sub

質問者が選んだベストアンサー

  • ベストアンサー
  • piroin654
  • ベストアンサー率75% (692/917)
回答No.1

rs.Openのところを、 rs.Open "SELECT Amazon2.区分, Amazon2.PO FROM Amazon2 GROUP BY Amazon2.区分, Amazon2.PO;", CurrentProject.Connection, adOpenStatic, adLockReadOnly として、DoCmd.OpenReportのところを、 DoCmd.OpenReport RPT_NAME, acViewPreview, , "[区分] = '" & rs!区分 & "' AND [PO]='" & rs!PO & "'" とします。なお、フィールドの型は区分、POともテキスト型としています。

Kanana0512
質問者

お礼

完璧なご回答をありがとうございます!!! 理想通りの回答(コピペできる内容)で頂きましたので 全くのど素人の私はそのままコピペさせて頂きました。 早速実行してみると同じ区分があった時にファイルが上書きされたので、 pdfName = rs!区分 & "_" & rs!PO だけ変えてみたら大成功でした。 やりたかった事を形にすることができました。 本当にありがとうございました。 これで業務改善が出来ます。 直接御礼をしたい位の感謝感激です。

関連するQ&A

  • ACCESS VBA ベージ毎のPDF化

    過去のご回答履歴を拝見して、質問をさせて頂きました。 VBAに関して全くのど素人で、インターネットで検索しながら 下記の文を書いてみました。 <状況> テーブル:Amazon2 この中にある"区分"というフィールドをグループのキーにして PDFファイルをCドライブに保存したい。 フォームはグループ化でページが分かれている状況です。 下記文章で実行すると「パラメータの入力」が開き(画像)、 表示されているのは"区分"なので表示と同じように入力すると フィルターされて出力されます。 この、「パラメータの入力」が開かずに実行できるようにするには どのように編集すれば可能でしょうか? ご教示頂ければ幸いです。 <作成した文> Option Compare Database Private Sub 分割PDF() Const TBL_NAME = "Amazon2" Const RPT_NAME = "Amazon for ESKER" Const PDF_PATH = "C:\Users\" Dim rs As ADODB.Recordset Set rs = New ADODB.Recordset rs.Open "SELECT DISTINCT 区分 FROM Amazon2", CurrentProject.Connection, adOpenStatic, adLockReadOnly Do Until rs.EOF pdfName = rs!区分 DoCmd.OpenReport RPT_NAME, acViewPreview, , "区分=" & rs!区分, acWindowNormal DoCmd.OutputTo acOutputReport, RPT_NAME, acFormatPDF, PDF_PATH & rs!区分 & ".pdf" DoCmd.Close rs.MoveNext Loop End Sub

  • ACCESSレポートをPDFに出力したい

    ACCESSでレポートを作成して、下記のVBAで管理番号(ID)別にPDFファイルで保存したいと思っています。保存名はIDにしたいと思っています。 管理番号ごとに出力する部分のコードが分からずに困っています。どなたかご教授頂けないでしょうか?よろしくお願いします。 Private Sub コマンド9_Click() Const TBL_NAME = "T_住所録" Const RPT_NAME = "R_住所録" Const PDF_PATH = "C:\Users\TEST\" Dim rs As ADODB.Recordset Set rs = New ADODB.Recordset rs.Open "SELECT DISTINCT ID FROM T_住所録", CurrentProject.Connection, adOpenStatic, adLockReadOnly Do Until rs.EOF pdfName = rs!ID DoCmd.OpenReport RPT_NAME, acViewPreview, , "ID = '" & rs("ID") & "'" DoCmd.OutputTo acOutputReport, RPT_NAME, acFormatPDF, PDF_PATH & pdfName & ".pdf" DoCmd.Close rs.MoveNext Loop End Sub 実行すると「出力データを指定したファイルに保存できません」とメッセージが出ます。

  • Acccess レポートをグループ別に出力する

    クエリ「納品書」を元にしたレポート「納品書」(※'クエリ名とレポート名は同名)は フィールド「顧客番号」(テキスト型)でグループ設定をしています。 レポートをPDF出力する際、グループごとにファイルを保存したいと思います。 しかし、VBA実行時に「パラメータが少な過ぎます。7を指定して下さい。」と エラーが出てしまい、行き詰まっています。 VBAの知識もほとんど無い為、どこで躓いているか教えていただけないでしょうか。 また、 他サイトで申し訳ありませんが・・・、 ●ACCESSVBA レポートをグループ毎に別のPDFファイルとして保存 http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q14108043684 こちらの回答を参考に、以下のように作成しました。 (以下、レコードソース) --------------------------- Const TBL_NAME = "納品書" Const RPT_NAME = "納品書"  Const PDF_PATH = "C:\Users\Desktop\ Dim rs As ADODB.Recordset Set rs = New ADODB.Recordset rs.Open "SELECT DISTINCT 顧客番号 FROM 納品書", CurrentProject.Connection, adOpenStatic, adLockReadOnly Do Until rs.EOF pdfName = rs!顧客番号 DoCmd.OpenReport RPT_NAME, acViewPreview, ,"顧客番号=" & rs!顧客番号, acWindowNormal DoCmd.OutputTo acOutputReport, RPT_NAME, acFormatPDF, PDF_PATH & Format(date,"yyyymmdd") & ".pdf" DoCmd.Close rs.MoveNext Loop ---------------------------

  • アクセスVBA。ADO

    CSVから列を分割してテーブルにしたいかったので 下記のコードを記述しましたが、 Dim cn As ADODB.Connection Dim rs As New ADODB.Recordset Dim datacount As Long Set cn = New ADODB.Connection With cn .ConnectionString = "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\;" .Properties("Extended Properties").Value = "text;HDR=YES;" .Open End With Set rs = cn.Execute("SELECT * FROM 構成マスタ.csv") datacount = rs.Fields.Count For i = 0 To datacount strsql = "SELECT " & rs.Fields(i).Name & " INTO " & rs.Fields(i).Name & " FROM 構成マスタ.csv;" cn.Execute strsql Next i rs.Close cn.Close Set rs = Nothing Set cn = Nothing SQLを実行するところで、「日付エラー」となってしまいます。 データには特に日付等はないのでエラーになる原因がわかりません。 どなたかご教示いただけますでしょうか。

  • エクセルVBAでアクセスのテーブルを操作

    アクセスのテーブルを名前を変えて保存したいのですが、エラー「2486:アクションを実行出来ない。」のメッセージが発生してしまいます。 構文は、以下の通りです。 Sub test() Dim ACC As Object Dim ACCC As ADODB.Connection Dim ACCR As ADODB.Recordset Dim SQL As String Set ACC = Access.Application Set ACCC = New ADODB.Connection Set ACCR = New ADODB.Recordset Const ACCpath = "D:\DB.mdb" SQL = "SELECT * FROM [dammy]" '接続し開く ACCC.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & ACCpath ACCR.Open SQL, ACCC, adOpenStatic, adLockOptimistic ACCR.MoveFirst If ACCR.Fields("日付").Value < DateSerial(Year(Now), 1, 1) Then ACC.DoCmd.CopyObject , "dammy(" & Year(Now) - 1 & "年)", acTable, "dammy" ACC.DoCmd.RunSQL "DELETE [dammy].* FROM [dammy];" End If End Sub エラー発生箇所は、IF文の中です。 対処方法を教えて下さい。 宜しくお願いします。

  • wshでcsvファイルのソートを行いたい

    wshのプログラムで困っているため教えてください。 wshでcsv(カンマ区切り)のファイルのソートを行い、Escel形式で保存するプログラムを書いています。 調べてみたところ、wshではソート関数がないようで、 adodbのsort関数を使用して対処しようとしていますが、どうもうまくいきません。 (※adodbの必要はないのですが、ExcelVBAのsortのコードを書こうとするとエラーになってしまったので、adodbにしています。) <仕様> csvファイルのソートのキーになるのは、「判定区分」の値で昇順に行いたいです。 csvファイルの一行目は、カラム名としてソート対象にはなりません。 読み込んだcsvファイルをexcel形式に保存したいです。 ■csvファイルの形式は、以下のような形です。 性別,年代,判定区分,生年月日,日付 女性,10,0,2010/01/10,2013/7/7 23:57 男性,50,2,2000/03/30,2013/7/7 13:7 女性,10,0,1990/01/20,2013/7/7 15:22 女性,20,1,2001/12/10,2013/7/7 8:10 *----------------------------------- <ソース> Set con = CreateObject("ADODB.Connection") With con .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Path & ";" _ & "Extended Properties='text;HDR=Yes;FMT=Delimited'" .Open End With Set rec = CreateObject("ADODB.Recordset") rec.Open "select * from " & csvfile & " order by 判定区分", con *----------------------------------- うまくいかないため ↓でも書いています。 *----------------------------------- Const adDate = 7 Const adVarChar = 200 Dim ans Set objADO = CreateObject("ADODB.Connection") Set rs = CreateObject("ADODB.Recordset") Set re = CreateObject("VBScript.RegExp") rs.Fields.Append "性別", adVarChar, 255 rs.Fields.Append "年代", adVarChar, 255 rs.Fields.Append "判定区分", adVarChar, 255 rs.Fields.Append "生年月日", adDate rs.Fields.Append "日付", adDate rs.Open ans = "" rs.Sort ="判定区分 ASC" rs.MoveFirst Do While Not rs.EOF ans = ans & rs.Fields(0).Value & vbCrLf rs.MoveNext Loop MsgBox ans エラーになってしまいます。 ソート処理だけですでににっちもさっちもいかないため、教えていただきたいです。 どうぞ宜しくお願いいたします。

  • アクセス2010のVBAについて教えて下さい

    前回<http://okwave.jp/qa/q8035701.html>で2つのエラーを解消していただきましたが、新たにDoCmd.SendObject acSendNoObject, , acFormatTXT, RS!Email, "aaa@aaa.mil", , Subject, Body, TrueSetで「2498指定した式はいずれかの引数とデータ型が対応してません」というエラーで止まってしまいました。 「RS!Email」を消すと、メールを生成するので、ここが違っているのは分かりましたが、どう直せばいいのかがわかりません。。「Email」のデータ型はテキスト型になっています。、ハイパーリンク型も試しましたがダメでした。さらに記述を「RS![Email]」としてみましたが、それもダメでした。。 どうぞよろしくお願いします。 Private Sub EmailReminder_Click() Dim DB As DAO.Database Dim QD As DAO.QueryDef Dim RS As DAO.Recordset Dim Subject As String Dim Body As String Subject = "Audit Corrective Actions" Body = "Good Morning Sir/Ma'am," & vbCrLf _ & "This is an auto generated email." & vbCrLf _ & "Please advise when these actions are completed. If you have any questions please feel free to contact our office. Thank you for your help and cooperation in this matter. Have a nice day." & vbCrLf & vbCrLf _ & "Corrective Actions:" & vbCrLf _ Set DB = CurrentDb() Set QD = DB.QueryDefs("ReminderQuery") With QD .Parameters("[Forms]![fmReport]![ReportID]") = Forms!fmReport!ReportID Set RS = .OpenRecordset Do Until RS.EOF Body = Body & "------------------------------------------------------" & vbCrLf _ & "[Due Date: " & RS!DueDate & "] [Agency: " & RS!Agency & "] [Report: " & RS!ReportNumber & "]" & vbCrLf _ & "Corrective Action: " & RS!CorrectiveAction & vbCrLf _ & "Recommendation: " & RS!Recommendation & vbCrLf RS.MoveNext Loop DoCmd.SendObject acSendNoObject, , acFormatTXT, RS!Email, "aaa@aaa.mil", , Subject, Body, True .Close End With End Sub

  • access vba 構文の解読

    access vba 構文の解読 はじめまして先ほどaccess2003について質問させていただいたものです。以下の構文が先ほどの続きです。こちらも皆様のお力で構文を解読していただけないでしょうか。 すみません解読とは、構文の一行一行が何を示しているのか教えていただけると助かります。 よろしくお願いいたします。 ' Exit the application. Case conCmdExitApplication CloseCurrentDatabase ' Run a macro. Case conCmdRunMacro DoCmd.RunMacro rs![Argument] ' Run code. Case conCmdRunCode Application.Run rs![Argument] ' Open a Data Access Page Case conCmdOpenPage DoCmd.OpenDataAccessPage rs![Argument] ' Any other command is unrecognized. Case Else MsgBox "不明なオプションです。" End Select ' Close the recordset and the database. rs.Close HandleButtonClick_Exit: On Error Resume Next Set rs = Nothing Set con = Nothing Exit Function HandleButtonClick_Err: ' If the action was cancelled by the user for ' some reason, don't display an error message. ' Instead, resume on the next line. If (Err = conErrDoCmdCancelled) Then Resume Next Else MsgBox "コマンド実行中のエラーです。", vbCritical Resume HandleButtonClick_Exit End If End Function Private Sub メニュー終了_Click() On Error GoTo Err_メニュー終了_Click DoCmd.Close Exit_メニュー終了_Click: Exit Sub Err_メニュー終了_Click: MsgBox Err.Description Resume Exit_メニュー終了_Click End Sub Private Sub 終了_Click() On Error GoTo Err_終了_Click DoCmd.Quit Exit_終了_Click: Exit Sub Err_終了_Click: MsgBox Err.Description Resume Exit_終了_Click End Sub

  • aspでaccessにデータを入れ替えすができない?

    以下のファイルを実行時にエラーを出てきました。どうすれば直るでしょうか?よろしくお願いします。 使用機械はNECのVC5002D、OSはXPのPRO(MEからのアップグレット)。 ------------------------ <% '分類訂正 Dim StrSQL, rs,newsclass_oldname,newsclass_newname Set rs = server.CreateObject("ADODB.Recordset") rs.LockType = adLockOptimistic StrSQL = "SELECT * FROM newsclass WHERE newsclass_name = '" & request("newsclass_oldname") & "'" newsclass_oldname=request("newsclass_oldname") newsclass_newname=request("newsclass_newname") rs.Open StrSQL, Con,,,adCmdText rs("newsclass_name") = request("newsclass_newname") rs.Update----------------line 13 %> ------------------------------------- HTTP 500.100 - 内部サーバー エラー - ASP エラー インターネット インフォメーション サービス -------------------------------------------------------------------------------- 技術情報 (サポート担当者用) エラー タイプ ADODB.Recordset (0x800A0BCD) BOF と EOF のいずれかが True になっているか、または現在のレコードが削除されています。要求された操作には、現在のレコードが必要です。 correctnewssort_2.asp, line 13

  • 【EXCEL VBA】ローカルmdbからデータを取得したい

    (環境)  WindowsXP  Excel2003  Access2003 現在、SQLサーバーからデータを取得しています。 下記のソースです(一部抜粋) Private Const SRC_SQL = "Provider=SQLOLEDB.1;User ID=testid;Password=testpass;Data Source=TEST-DB-1;Initial Catalog=testDB" Private Const TBL_TEST = "TEST.テストテーブル" Public Sub TEST_PRO Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Set cn = CreateObject("ADODB.Connection") cn.CommandTimeout = 0 cn.Open SRC_SQL strSQL = "SELECT X.*, FROM " & TBL_TEST & " X" strSQL = strSQL & " WHERE X.担当者CD = '" & wNAME & "'" strSQL = strSQL & " AND X.オープン日 >= '" & start_dt & "'" strSQL = strSQL & " AND X.オープン日 < '" & end_dt & "'" strSQL = strSQL & " ORDER BY X.オープン日 ASC" Set rs = CreateObject("ADODB.Recordset") rs.Open strSQL, cn With rs ~~~ End With Set rs = Nothing End Sub これを、SQLサーバーではなく、 C:\TESTACCESS.mdbのテーブル:テストテーブル からデータを取得するように変更したいのですが、 どのようにコーディングすればよろしいでしょうか? よろしくお願いします。

専門家に質問してみよう