Microsoft Access 掲示板

質問がざっくりなので回答もざっくりになりますが

「共通部分はひとまとめに、処理を変えたいところは変数にしてプログラム内で任意に変更できるように」します

リンク先のコードを参考にするなら

  'データ元のクエリを開く
  Set dbs = CurrentDb
  Set rst = dbs.OpenRecordset("qsel受注伝票")


    '保存するファイル名のフルパスを組み立て
    strSaveBookPath = cstrSaveBookDir & "受注伝票_" & Format$(lngOrderID, "00000") & ".xlsx"

この部分が変数にする（固定では困る）部分ですかね

例えば

Public Sub ExcelTemplateSample(queryName As String, fileName As String)

  'データ元のクエリを開く
  Set dbs = CurrentDb
  Set rst = dbs.OpenRecordset(queryName)


    '保存するファイル名のフルパスを組み立て
    strSaveBookPath = cstrSaveBookDir & fileName & ".xlsx"

のように変更して

Sub test()
  ExcelTemplateSample "qsel特別会員", "特別会員"
  ExcelTemplateSample "qsel通常会員", "通常会員"
  ExcelTemplateSample "qselビジター", "ビジター"
End Sub

と、出力処理を3回実行してやればファイルを3つ作ることができます

回答いただきありがとうございます。

Sub test()
  ExcelTemplateSample "qsel特別会員", "特別会員"
  ExcelTemplateSample "qsel通常会員", "通常会員"
  ExcelTemplateSample "qselビジター", "ビジター"
End Sub

こちらですが、特別会員、通常会員、ビジターの3つのクエリを作成するということでしょうか？

また、質問で提示したURL先のコードですが実行するとエラーが出てしまいました。

'テンプレートの保存先フォルダ
  Const cstrTemplateDir As String = "C:\テスト\"
  'テンプレートのファイル名
  Const cstrTemplateBook As String = "受注伝票テンプレート.xlsx"
  'データが代入されたファイルの保存先フォルダ
  Const cstrSaveBookDir As String = "C:\テスト\"

ここで指定したファイルパスが間違っていると出ます。
実行時エラーは1004です。
しかし、確かにここに格納されていますし、Shift+右クリックでパスのコピーをしてそのまま貼り付けています。
そしてデバッグを押すと、

'テンプレートファイルを開く
    .Workbooks.Open cstrTemplateDir & cstrTemplateBook

ここが黄色くなります。

原因が分からず困っています・・・
もしこの原因がわかるようでしたら教えて頂けるとありがたいです。

重ねての質問になり申し訳ありません。

元の質問にも追記しました。

回答ありがとうございます。
ファイルの件提示してい頂いた内容をもとに考えてみたいと思います。
ありがとうございました。

エラーの件ですが、

.Workbooks.Open "C:\テスト\受注伝票テンプレート.xlsx"

こちらに書き換えたところエラーが移り変わりました。

 'ワークシートをコピー
    .Workbooks(cstrTemplateBook).Worksheets("sheet1").Copy

次はこれにエラーが出て、実行時エラー9「インデックスが有効範囲にありません」と出ます、、
やはりファイルが悪さしてるのでしょうか？
ちなみにシート名も間違いがないようコピーして貼り付けています、、

ファイル自体が悪さをしているというのはあまり経験がありません。コード自体は単純な処理なので、パス、ファイル名の作り方や単純なタイプミスをまず疑ってしまいます

コピー処理の前後を次のようにするとどうなりますか？

If Dir(cstrTemplateDir & cstrTemplateBook) = "" Then
    MsgBox cstrTemplateDir & cstrTemplateBook & "は存在しません"
End If

Dim xlBook As Object

 'ワークシートをコピー
    Set xlBook = .Workbooks(cstrTemplateBook)
    xlBook.Worksheets("sheet1").Copy
    Set xlBook = Nothing