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

2018/11/21

VB.NET-Tipsではないのですが、この記事から Visual Basic 繋がりで、VBA(Visual Basic for Applications)についても番外的な記事として載せていこうと思います。

access vba でWordを起動しWordファイルを読込んだ後で、ファイルを保存する時に読込みファイル名に日付と時刻を自動で付加する必要が在ったので、できるのか調べてみました。

Wordのメニューから「名前を付けて保存」や「上書き保存」などを選択した時に、 DocumentBeforeSave のイベントが発生することは分かったのですが、これの例としては、以下の様に保存の前の確認を行うものしかありませんでした。
どうすればこのタイミングでファイル名を変更できるのかが知りたいことでしたが、調べ方が悪いのかネットには例がありませんでした。

DocumentBeforeSave を使った簡単な例

Private Sub WordApp_DocumentBeforeSave(ByVal Doc As Word.Document, SaveAsUI As Boolean, Cancel As Boolean)
    Dim intRet As Integer
    intRet = MsgBox("ドキュメントを保存しますか？", vbYesNo)
    If intRet = vbNo Then
        Cancel = True
    End If
End Sub

この例では、Wordでのファイル書き込み時に DocumentBeforeSave のイベントでファイル名を変更してやれば出来るようなかんじでした。しかし、ことはそんなに簡単ではなく、 DocumentBeforeSave のイベントの引数内の Doc ですがこの中のプロパティで name が在ったのでこれを変更すればと思ったのですが、これは Readonly のプロパティで変更できない様です。

ならば、 DocumentBeforeSave のイベントの中で、ファイル名を変更後、自分で保存ダイアログを表示すればよいことに気が付きました。

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

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

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

Option Compare Database

' Wordオブジェクト
Private WithEvents WordApp As Word.Application

' Word.Documentオブジェクト
Private WordDoc As Word.Document

'------------------------------------------------------------------------------
' Word文書編集開始
'------------------------------------------------------------------------------
Private Sub コマンド1_Click()
    Dim strPath As String
    
    'word起動
    'Set WordApp = CreateObject("Word.application")   'BUG-FIX
    Set WordApp = New Word.Application

    'ワードファイルを読み込み、文章を編集する状態にする
    strPath = Application.CurrentProject.path & "\" & "sample.docx"
    Set WordDoc = WordApp.Documents.Open(strPath)   '編集モードで開く
    'Wordを表示
    WordApp.Visible = True
    'Wordをアクティブ化
    WordApp.Activate
End Sub

'------------------------------------------------------------------------------
' Word・保存前イベント処理
'------------------------------------------------------------------------------
Private Sub WordApp_DocumentBeforeSave(ByVal Doc As Word.Document, SaveAsUI As Boolean, Cancel As Boolean)
    Dim strPath As String

    '日付・時刻を[yyyymmdd-hhnnss-]形式でファイル名の先頭に付加
    strPath = Doc.path & "\" & Format$(Now, "yyyymmdd-hhnnss-") & Doc.Name

    '自分で新しいファイル名でDialogを呼出す
    With WordApp.Dialogs(wdDialogFileSaveAs)
        .Name = strPath
        .Show
    End With

    '通常のDialogの非表示
    Cancel = True
End Sub

'------------------------------------------------------------------------------
' Word・終了イベント処理
'------------------------------------------------------------------------------
Private Sub WordApp_Quit()
    'Wordオブジェクト解放
    Set WordDoc = Nothing
    Set WordApp = Nothing
End Sub

'------------------------------------------------------------------------------
' フォームを閉じる時のイベント
'------------------------------------------------------------------------------
Private Sub Form_Close()
    If Not WordApp Is Nothing Then
        'Wordオブジェクト解放
        Set WordDoc = Nothing
        Set WordApp = Nothing
    End If
End Sub

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

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

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

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

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