AccessVBAでレポートをPDF出力するときの落とし穴5つと対策

DoCmd.OutputTo acOutputReport, "R_受注明細", acFormatPDF, "C:\work\受注明細.pdf"

DoCmd.OpenReport "R_受注明細", acViewPreview, , "受注番号=2", acHidden
DoCmd.OutputTo acOutputReport, "R_受注明細", acFormatPDF, "C:\work\受注明細.pdf"
DoCmd.Close acReport, "R_受注明細", acSaveNo

If CurrentProject.AllReports("R_受注明細").IsLoaded Then
    DoCmd.Close acReport, "R_受注明細", acSaveNo
End If

Private Sub Report_NoData(Cancel As Integer)
    Cancel = True
End Sub

'=========================================================
'  プロシージャ名：gf_OUTPUT_PDF
'  機能　　：レポートを条件付きでPDFに出力します。
'
'  【引数】
'    strReport   ：レポート名
'    strWhere    ：抽出条件（例："受注番号=2"）
'    strFilePath ：出力先のフルパス
'    strSource   ：0件チェックに使うテーブル名/クエリ名（省略可）
'
'  【戻り値】
'    True ：出力成功　／　False ：出力しなかった・失敗
'
'  【使用例】
'    Call gf_OUTPUT_PDF("R_受注明細", "受注番号=2", _
'                       "C:\work\受注明細_2.pdf", "T_受注明細")
'=========================================================
Public Function gf_OUTPUT_PDF(strReport As String, strWhere As String, _
                              strFilePath As String, _
                              Optional strSource As String = "") As Boolean
    On Error GoTo err_OUTPUT_PDF
    gf_OUTPUT_PDF = False
    '=== 0件なら出力しない ===
    If strSource <> "" Then
        If DCount("*", strSource, strWhere) = 0 Then
            MsgBox "出力するデータがありません。", vbExclamation
            Exit Function
        End If
    End If
    '=== 同名ファイルがあれば削除（開かれていて消せなければ中止）===
    If Dir(strFilePath) <> "" Then
        On Error Resume Next
        Kill strFilePath
        On Error GoTo err_OUTPUT_PDF
        If Dir(strFilePath) <> "" Then
            MsgBox "出力先のファイルが他のアプリで開かれています。" & vbCrLf & _
                   "ファイルを閉じてから、もう一度実行してください。" & vbCrLf & _
                   strFilePath, vbExclamation
            Exit Function
        End If
    End If
    DoCmd.Hourglass True
    '=== 既に開いているとWhere条件が効かないため、先に閉じる ===
    If CurrentProject.AllReports(strReport).IsLoaded Then
        DoCmd.Close acReport, strReport, acSaveNo
    End If
    '=== 条件を付けて非表示で開き、開いたレポートをPDFにする ===
    DoCmd.OpenReport strReport, acViewPreview, , strWhere, acHidden
    DoCmd.OutputTo acOutputReport, strReport, acFormatPDF, strFilePath
    DoCmd.Close acReport, strReport, acSaveNo
    DoCmd.Hourglass False
    gf_OUTPUT_PDF = True
    Exit Function
err_OUTPUT_PDF:
    DoCmd.Hourglass False
    If Err.Number = 2501 Then
        '=== レポートの「空データ時」でキャンセルされた ===
        MsgBox "出力するデータがありません。", vbExclamation
    Else
        MsgBox "【gf_OUTPUT_PDF】PDF出力中にエラー発生" & vbCrLf & _
               "番号：" & Err.Number & vbCrLf & _
               "内容：" & Err.Description, vbCritical
    End If
    On Error Resume Next
    DoCmd.Close acReport, strReport, acSaveNo
End Function

'=========================================================
'  プロシージャ名：gf_SAFE_FILENAME
'  機能　　：ファイル名に使えない文字を「_」に置き換えます。
'
'  【使用例】
'    gf_SAFE_FILENAME("A/B邸 見積") → "A_B邸 見積"
'=========================================================
Public Function gf_SAFE_FILENAME(strName As String) As String
    Dim l_ng As Variant           ' 使えない文字
    Dim l_str As String           ' 変換後の文字列
    Dim i As Integer
    l_ng = Array("\", "/", ":", "*", "?", """", "<", ">", "|", vbTab, vbCr, vbLf)
    l_str = strName
    For i = 0 To UBound(l_ng)
        l_str = Replace(l_str, l_ng(i), "_")
    Next i
    gf_SAFE_FILENAME = Trim(l_str)
End Function

Private Sub Cmd_Pdf_Click()
    Dim l_path As String          ' 出力先のフルパス
    l_path = CurrentProject.Path & "\" & _
             gf_SAFE_FILENAME(Me.Txt_Tokuisaki & "_受注明細_" & Me.Txt_JuchuNo) & _
             "_" & Format(Now, "yyyymmdd_hhnnss") & ".pdf"
    If gf_OUTPUT_PDF("R_受注明細", "受注番号=" & Me.Txt_JuchuNo, l_path, "T_受注明細") Then
        Application.FollowHyperlink l_path
    End If
End Sub