Access レポートのPDF化 保存先ダイアログを開いて決定し、名前はVBAコードで指定

Question

前提・実現したいこと

こんにちは。Access VBAを用いたレポートのPDF出力について質問です。出力・保存されるPDFファイルのファイル名だけはこちらで指定して、保存先は都度保存ダイアログを開いて選択する方法を教えていただきたいです。

以下のように、何パターンかコードを書き変えて試したのですが、うまくいきませんでした。

上手くいかなかったコード

DoCmd.OutputTo acOutputReport, "R_レポート名", acFormatPDF, "C:保存先パス\保存するPDF名.pdf"
➞名前はこちらで決められるが、保存先を事前にコードで指定しなくてはならず、都度保存ダイアログを開けない。

DoCmd.OutputTo acOutputReport, "R_レポート名", acFormatPDF, "保存するPDF名.pdf"
➞名前はこちらで決められるが、勝手にPCのドキュメントに保存される。

DoCmd.OutputTo acOutputReport, "R_レポート名", acFormatPDF
➞都度保存ダイアログを開いて保存先を決められるが、ファイル名が「R_レポート名」に固定されてしまう。

以下2つの条件を満たすには、どうすればいいのでしょうか。
➀出力するPDFの名前はこちらで決められる
➁保存先は都度ダイアログを開いて決められる

Answer 1

• ファイル名はコードで指定する（ユーザーは勝手に変更できない）。
• 保存するフォルダーはユーザーに選択させたい。

ということでしょうか。

下記で紹介されているgetFolderName関数を使うといいでしょう。

AccessのVBAでファイルダイアログからフォルダを指定する方法｜アズビーパートナーズ

'--------------------------------------------------------------------
'フォルダ選択ダイアログ
'---------------------------------------------------------------------

Public Function getFolderName(tmpFilePath As String) As String

    Dim intret As Integer
    
    With Application.FileDialog(msoFileDialogFolderPicker)
    
        'ダイアログのタイトルを設定
        .Title = "フォルダ選択ダイアログ"
        
        'デフォルトのフォルダパス
        .InitialFileName = tmpFilePath
        
        'ダイアログを表示
        intret = .Show
        If intret <> 0 Then
          'フォルダが選択されたとき戻り値に設定
          getFolderName = Trim(.SelectedItems.Item(1))
        Else
          'フォルダが選択されなければ長さゼロの文字列を返す
          getFolderName = ""
        End If
    End With

End Function

上記のコードをコピーして標準モジュールに貼り付けます。
[ツール]-[参照設定]で「Microsft Office xx.x Object Library」 にチェックをいれておく。
（リンク先に画像付きで解説されます。）

上記の関数を使って下記のようなコードにすればいいでしょう。

    Dim FolderName As String
    FolderName = getFolderName(“”) '引数に初期値のフォルダーパスを設定、""にするとドキュメントフォルダー

    If FolderName  = "" Then
        MsgBox "キャンセルされました。"
    Else
        DoCmd.OutputTo acOutputReport, "R_レポート名", acFormatPDF, _
                       FolderName & "\保存するPDF名.pdf"
    End If

Comments

[sazi]

質問はフォルダではなくファイル名ですよ。
ああ、前提付きの回答なんですね。

[hatena19]

タイトルの「名前はVBAコードで指定」とか、質問の「➀出力するPDFの名前はこちらで決められる」「➁保存先は都度ダイアログを開いて決められる」からファイル名はコードで固定、ユーザーは保存先（フォルダ）をダイアログで選択できるのが質問者さんの希望と解釈しました。
この解釈が前提です。

[sazi]

私の方が勘違いですね。

[NGK]

要件をしっかり伝えきれずにいたのにも関わらず、意図をくみ取ってくださりありがとうございました。こちらに記載していただいたコードで、希望通りの動きをすることができました。sazi様、hatena19様共にベストアンサーを差し上げたいのですが、今回は素人目にコードの理解・転用が簡単なhatena19様をベストアンサーとさせていただきます。

Answer 2

保存先を選択ダイアログで決定し、後は以下の処理で行えば良いかと。

DoCmd.OutputTo acOutputReport, "R_レポート名", acFormatPDF, "C:保存先パス\保存するPDF名.pdf"
➞名前はこちらで決められるが、保存先を事前にコードで指定しなくてはならず、都度保存ダイアログを開けない。

VBA:AccessのFileDialogを使用して[名前を付けて保存]ダイアログボックスを表示するサンプルプログラム
追記

こんな感じ。
※msoFileDialogSaveAsの場合は、フィルター出来ないのが難点ですけどね。

Function SaveAsFileDialog()
  With Application.FileDialog(msoFileDialogSaveAs)
    'FileDialogオブジェクトの各種プロパティを設定
    .Title = "別名保存"
    .ButtonName = "保存実行" 'デフォルトは[保存(&S)]
    .InitialFileName = CurrentProject.Path
    '複数ファイル選択を許可しない
    .AllowMultiSelect = False
   
   '[名前を付けて保存]ダイアログボックスを表示する
    If .Show Then
        SaveAsFileDialog = .SelectedItems(1)
    Else
        SaveAsFileDialog = ""
    End If
  End With
End Function
Sub PDF化コード()
  Dim FileName As String
  FileName = SaveAsFileDialog
  If FileName <> "" Then
    DoCmd.OutputTo acOutputReport, "R_レポート名", acFormatPDF, FileName
  End If
End Sub

フォルダ選択だったようなので、自作のFunctionを提供しておきます。

Public Function MyFileDialog(pType, pTitle, Optional pFileterTitle, Optional pFileter, Optional pPath="") As String
  Dim wGetFileName
  wGetFileName = ""
  With Application.FileDialog(pType)
      'ダイアログのタイトルを設定
      .title = pTitle
      If pType = 3 Then
        'ファイルの種類を設定
        .Filters.Clear
        .Filters.Add pFileterTitle, pFileter
        .FilterIndex = 1
        '複数ファイル選択を許可しない
        .AllowMultiSelect = False
      End If
      '初期パスを設定
      If Nz(pPath) <> "" Then
        .InitialFileName = pPath
      Else
        .InitialFileName = CurrentProject.path
      End If
      'ダイアログを表示
      If .Show <> 0 Then
        'ファイルが選択されたとき
        'そのフルパスを返り値に設定
        wGetFileName = Trim(.SelectedItems.Item(1))
      End If
  End With
  MyFileDialog = wGetFileName
End Function
Sub PDF化コード()
  Dim FldName As String
  FldName = MyFileDialog(4, "PDF保存先を選択")
  If FldName <> "" Then
    DoCmd.OutputTo acOutputReport, "R_レポート名", acFormatPDF, FldName & "\保存するPDF.pdf"
  End If

Comments

[NGK]

頂いたサイトのコードを参考にやりたい挙動を再現しようと思ったのですが、理解が足りず実装できませんでした。「保存先を選択ダイアログで決定し、後は以下の処理で行えば良いかと。」とのことでしたが、もう少し詳細な手順を教えていただけないでしょうか…。

Function GetFileName(OpenOrSaveFlg As Boolean) As Variant
Dim returnValue As Integer
Dim strFilePath As String
WizHook.Key = 51488399 'WIZHOOKを有効化する
returnValue = WizHook.GetFileName( _
0, "", "", "", strFilePath, "", _
"PDF (*.pdf)|*.pdf", _
0, 0, 0, OpenOrSaveFlg _
)
WizHook.Key = 0 ' WizHook 無効化

'returnValueとstrFilePathの2つの値を返す
'returnvalueの値を返すことで[キャンセル]が押されたかを判断するため
GetFileName = Array(returnValue, strFilePath)

End Function

sub PDF化コード()
Dim ReturnArray As Variant
ReturnArray = GetFileName(False) 'この引数をFalseにすると保存ダイアログ

If ReturnArray(0) = -302 Then
'キャンセルボタンが押されたときの処理を記述
MsgBox "キャンセルが押されました。"
Else
DoCmd.OutputTo acOutputReport, "R_レポート名", acFormatPDF, "C:保存先パス\保存するPDF名.pdf"
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
End Sub

[sazi]

なんで、Accessのウィザード用のダイアログでやろうとしてるのか分かりませんが、追記しておきました。
※参照設定は忘れずに。