access vba でExcelを起動しファイル保存でのファイル名変更について（WorkbookBeforeSave : Excel保存前イベント）

2018/11/22

昨日は、access vba でWordを起動しWordファイルを読込んだ後で、ファイルを保存する時に読込みファイル名に日付と時刻を自動で付加する方法についての記事を載せましたが、今日は、同様に access vba でExcelを起動しExcelファイルを読込み後、ファイル保存時にファイル名に日付と時刻を自動で付加する方法を紹介します。

Wordの時と同様に、Excelのメニューから「名前を付けて保存」や「上書き保存」などを選択した時に、 WorkbookBeforeSave のイベントが発生します。
このイベント処理の中で、指定されたファイル名に日付と時刻をファイルの先頭に付加し、ファイル保存ダイアログをコールします。

尚、今回のイベントを利用するためには、accessの参照設定で「Microsoft Excel Object Library」の指定が必要です。私の環境では Excel2013 なので「Microsoft Excel 15.0 Object Library」でした。

では、以下にそのソース全体を示します。

WorkbookBeforeSave イベントでファイル名を変更し保存する例

Option Compare Database
 
' Excelオブジェクト
Private WithEvents ExcelApp As Excel.Application
 
' Excel.Workbookオブジェクト
Private ExcelBook As Excel.Workbook
 
' イベント呼び出し中フラグ
Private fBeforeSaveCall As Boolean
 
'------------------------------------------------------------------------------
' Word文書編集開始
'------------------------------------------------------------------------------
Private Sub コマンド1_Click()
    Dim strPath As String
     
    'Excelオブジェクト生成
    Set ExcelApp = CreateObject("Excel.application")
 
    'Excelファイルを読み込み、文章を編集する状態にする
    strPath = Application.CurrentProject.path & "\" & "sample.xlsx"
 
    Set ExcelBook = ExcelApp.Workbooks.Open(strPath) '編集モードで開く
    ExcelApp.Visible = True
 
    fBeforeSaveCall = False
End Sub
 
 
'------------------------------------------------------------------------------
' Excel・保存前イベント処理
'------------------------------------------------------------------------------
Private Sub ExcelApp_WorkbookBeforeSave(ByVal Wb As Excel.Workbook, ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim strPath As String
    '日付・時刻を[yyyymmdd-hhnnss-]形式でファイル名の先頭に付加
    strPath = Wb.path & "\" & Format$(Now, "yyyymmdd-hhnnss-") & Wb.Name
     
    '既に保存前イベントが呼ばれている
    If fBeforeSaveCall = True Then
        Exit Sub
    End If
     
    '保存前イベント呼び出し中フラグON
    fBeforeSaveCall = True
    '新しいファイル名でDialogを呼出す
    ExcelApp.Dialogs(xlDialogSaveWorkbook).Show strPath
    '保存前イベント呼び出し中フラグOFF
    fBeforeSaveCall = False
     
    '通常のDialogの非表示
    Cancel = True
End Sub
 
'------------------------------------------------------------------------------
' Excel・終了イベント処理
'------------------------------------------------------------------------------
Private Sub ExcelApp_Quit()
    Set ExcelBook = Nothing
    Set ExcelApp = Nothing
End Sub
 
'------------------------------------------------------------------------------
' フォームを閉じる時のイベント
'------------------------------------------------------------------------------
Private Sub Form_Close()
    If Not ExcelApp Is Nothing Then
        'Wordオブジェクト解放
        Set ExcelBook = Nothing
        Set ExcelApp = Nothing
    End If
End Sub

このプログラムの例では、access のフォームに１個のボタンのみを持たせています。実行すると以下の様な表示になります。

上記のソースは、フォームのvbaの静的変数で、Excelオブジェクトを WithEvents 付きで宣言します。 WithEvents 付きとすることで、vba のコード入力時にイベントの選択が以下の様にできます。

このソースで重要なのは、 WorkbookBeforeSave のイベント処理の中で、自分でファイル名を変更し、 Excelオブジェクトのファイル保存ダイアログを直接コールし、その後でこのイベントが呼ばれた元のダイアログ処理を Cancel を True にして返すことでキャンセルすることです。

さらに、ダイアログ処理を呼出すと、この WorkbookBeforeSave のイベントが再度発生する為、自分自身のダイアログ呼び出しでのイベントは処理しない様にします。そのため、イベント処理中のフラグを宣言し、ダイアログ処理の前後でフラグをON・OFFし、イベントの再入を防いでいます。

Excelオブジェクトの終了イベント(Quit)では念のため、Wordオブジェクト変数をクリアしています。
また、フォームを閉じる時のイベントでもExcelオブジェクト変数がクリアではない場合に、クリアしています。

実際にExcelで保存を選択した場合には、以下の様な表示なります。