Access 実行時エラー 2017でプログラムが終了してしまいます。

Question

Access　で　VBAのスクリプトを作成し、コードをパスワードで保護しました。

すると、特定の動作をさせると、次のエラーが出てプログラムが終了してしまいます。

実行時エラー　'2017’:

Visual Basic for Applications(VBA)プロジェクトの保護をパスワードで促進しようとしています。この操作を行う前にVisual Basic Editor9(VBE)でパスワードを入力する必要があります。

コードにパスワードをかけていないときには、このエラーは発生しません。コード保護時にしかエラーが再現しないので、どの行でエラーが出たのか突き止めるのは難しいです。

Webで検索した結果、同じことで悩んでいる方を見つけましたが、問題は未解決のようです。

http://www.access-programmers.co.uk/forums/showthread.php?t=171158

この方はファイルのリネームでエラーが出たといっていますが、私の場合も、ファイルの読み書き、コピーをするところでした。

この問題は複数のOS,Accessのバージョンで再現性良く発生しました。

Windows2000、Access2000

Windows2000、Access2003

WindowsVista、Access2007

なんとか、このエラーを回避する方法はないでしょうか。もちろんコードにパスワードをかけなければ回避できますが、運用上それは無理です。

Answer 1

別の掲示板で原因を教えていただきました。

文書番号: 205085 - 最終更新日: 1999年8月6日 - リビジョン: 1.0[ACC2000]保護された VBA プロジェクトからモジュールをインポートできないhttp://support.microsoft.com/default.aspx?scid=kb;ja;JP205085回避策　保護されている VBA プロジェクトに対して、インポートやエクスポート時にパスワードを入力することはできません。　^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^　保護されているプロジェクトを開いた状態でモジュールをエクスポートする必要があります。　また、エクスポートやインポートの対象となるデータベースの両方にパスワードで保護されている場合は、　エクスポート先、またはインポート元となるプロジェクトからパスワードを削除します。

そこで解決策です。なぜかテーブルだけは読み込めていたので、いろんなレポートが入っているテンプレートファイルを複数作り、そこにテーブルを読み込ませることで解決しました。

Public Sub ファイル出力(ByVal startDay, ByVal endDay As Date, ByVal 出力ファイル, ByVal 出力テーブルレポート As String)

Dim 出力フォルダ, テンプレートフォルダ, テンプレートファイル, テンプレートパス, 仮パス, 仮パス2, 本パス, pw, reportHikisu As String

出力フォルダ = Get出力フォルダ()

テンプレートフォルダ = Getテンプレートフォルダ()

テンプレートファイル = "Templete" & 出力テーブルレポート & ".mdb"

出力ファイル = 出力ファイル & CStr(Year(startDay)) & "年" & CStr(Month(startDay)) & "月" & CStr(Day(startDay)) & "日"

出力ファイル = 出力ファイル & "～" & CStr(Year(endDay)) & "年" & CStr(Month(endDay)) & "月" & CStr(Day(endDay)) & "日"

出力ファイル = 出力ファイル + "_" & CStr(Hour(Time)) & "_" & CStr(Minute(Time)) & ".mdb"

reportHikisu = CStr(Year(startDay)) & "年" & CStr(Month(startDay)) & "月" & CStr(Day(startDay)) & "日"

reportHikisu = reportHikisu & "～" & CStr(Year(endDay)) & "年" & CStr(Month(endDay)) & "月" & CStr(Day(endDay)) & "日"

Setレポート引数 (reportHikisu)

テンプレートパス = テンプレートフォルダ & "" & テンプレートファイル

仮パス = テンプレートフォルダ & "\TEMP" & 出力ファイル

仮パス2 = テンプレートフォルダ & "\TEMP2" & 出力ファイル

本パス = 出力フォルダ & "" & 出力ファイル

If Dir(本パス) <> "" Then

MsgBox "同じデータのファイルが存在します。パスワードがかかっていて削除できません。"

Exit Sub

End If

FileCopy テンプレートパス, 仮パス

DoCmd.TransferDatabase acExport, "Microsoft Access", 仮パス, , "レポート引数", "レポート引数"

DoCmd.TransferDatabase acExport, "Microsoft Access", 仮パス, , "責任者リスト", "責任者リスト"

DoCmd.TransferDatabase acExport, "Microsoft Access", 仮パス, , 出力テーブルレポート, 出力テーブルレポート

pw = Getrptpw()

If pw = "" Then

FileCopy 仮パス, 仮パス2

Else

DBEngine.CompactDatabase 仮パス, 仮パス2, dbLangJapanese & ";pwd=" & pw

End If

Kill 仮パス

FileCopy 仮パス2, 本パス

Kill 仮パス2

MsgBox "期間指定詳細が " + 本パス + " に出力されました。プリンタのあるパソコンから印刷してください。"

End Sub

Answer 2

その後、エラーを起こした行がわかりましたので報告します。

Public Sub ファイル出力(ByVal startDay, ByVal endDay As Date, ByVal 出力ファイル, ByVal 出力テーブルレポート As String)

    Dim 出力フォルダ, テンプレートフォルダ, 仮パス, 仮パス2, 本パス, pw, reportHikisu As String

    出力フォルダ = Get出力フォルダ()

    テンプレートフォルダ = Getテンプレートフォルダ()

    出力ファイル = 出力ファイル & CStr(Year(startDay)) & "年" & CStr(Month(startDay)) & "月" & CStr(Day(startDay)) & "日"

    出力ファイル = 出力ファイル & "～" & CStr(Year(endDay)) & "年" & CStr(Month(endDay)) & "月" & CStr(Day(endDay)) & "日"

    出力ファイル = 出力ファイル + "_" & CStr(Hour(Time)) & "_" & CStr(Minute(Time)) & ".mdb"

    reportHikisu = CStr(Year(startDay)) & "年" & CStr(Month(startDay)) & "月" & CStr(Day(startDay)) & "日"

    reportHikisu = reportHikisu & "～" & CStr(Year(endDay)) & "年" & CStr(Month(endDay)) & "月" & CStr(Day(endDay)) & "日"

    Setレポート引数 (reportHikisu)

    仮パス = テンプレートフォルダ & "\TEMP" & 出力ファイル

    仮パス2 = テンプレートフォルダ & "\TEMP2" & 出力ファイル

    本パス = 出力フォルダ & "" & 出力ファイル

    If Dir(本パス) <> "" Then

        MsgBox "同じデータのファイルが存在します。パスワードがかかっていて削除できません。"

        Exit Sub

    End If

    FileCopy テンプレートフォルダ & "\templete.mdb", 仮パス

    DoCmd.TransferDatabase acExport, "Microsoft Access", 仮パス, , "レポート引数", "レポート引数"

    DoCmd.TransferDatabase acExport, "Microsoft Access", 仮パス, , "責任者リスト", "責任者リスト"    

    DoCmd.TransferDatabase acExport, "Microsoft Access", 仮パス, , 出力テーブルレポート, 出力テーブルレポート

    'この次の行でエラーを起こしていました

    DoCmd.TransferDatabase acExport, "Microsoft Access", 仮パス, acReport, 出力テーブルレポート, 出力テーブルレポート    

    DoCmd.TransferDatabase acExport, "Microsoft Access", 仮パス, acReport, "責任者リストのサブレポート2", "責任者リストのサブレポート2"

    pw = Getrptpw()

    If pw = "" Then

        FileCopy 仮パス, 仮パス2

    Else

        DBEngine.CompactDatabase 仮パス, 仮パス2, dbLangJapanese & ";pwd=" & pw

    End If

    Kill 仮パス

    FileCopy 仮パス2, 本パス

    Kill 仮パス2

    MsgBox "期間指定詳細が " + 本パス + " に出力されました。プリンタのあるパソコンから印刷してください。"

End Sub