WordVBAのテンプレート（Normal.dotm）への保存と失敗

ExcelVBAの場合は、汎用的に利用したいコードは、個人マクロブック等に保存して利用する方も多いと思います。
WordVBAの場合は、標準テンプレート（Normal.dotm）に保存します。

ただし、標準テンプレート（Normal.dotm）は破損したり、保存失敗することが多いです。（個人的な体感）
OneDriveを使用していない私の職場では保存失敗することはほぼないのですが、OneDraveを使用している私用のPCの場合は、結構な割合で標準テンプレート（Normal.dotm）への保存自体が失敗して「せっかくこんなにコード書いたのに…(T_T)」となることが多いです。（根本的な原因は、現時点では分からず、、、）

そのため、個人的な対策として、そもそも標準テンプレート（Normal.dotm）への保存は失敗するものとして、都度、標準テンプレート（Normal.dotm）内の標準モジュールのバックアップを取っておき、保存失敗していた場合には、バックアップから標準モジュールをインポートすることとしました。

Sub 標準テンプレートの全標準モジュールを出力()
'標準テンプレートのすべての標準モジュールをダウンロードフォルダへエクスポートする
'※1 Wordの設定で「VBAプロジェクト オブジェクトモデルへのアクセスを信頼する」にチェックを入れる必要がある
'※2 「Microsoft Visual Basic for Applications Extensibility 5.3」への参照設定が必要

    Dim vbaModule      As vbComponent   'VBAモジュール
    Dim extension      As String        'モジュールの拡張子
    Dim exportPath     As String        'ダウンロードフォルダのパス
    Dim exportFilePath As String        'エクスポートするファイルのパス
    Dim targetDoc      As Document      '対象テンプレート

    ' 対象のドキュメントとして現在のテンプレート（標準テンプレート）を設定
    Set targetDoc = ThisDocument

    ' ダウンロードフォルダのパスを取得
    exportPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    exportPath = Replace(exportPath, "\Desktop", "\Downloads", 1, 1)  ' ダウンロードフォルダに変更
    exportPath = Replace(exportPath, "\OneDrive", "", 1, 1)   'OneDriveを利用している場合はそのままだと「C:\User\dummy\OneDrive\Downloads」となりアクセスできないため
        
    ' エラーハンドリングを追加（VBProjectへのアクセスが失敗した場合に備える）
    On Error GoTo エラー処理
    If Not targetDoc.VBProject Is Nothing Then
        ' VBAプロジェクト内のすべてのコンポーネントをループ
        For Each vbaModule In targetDoc.VBProject.VBComponents
            ' 標準モジュールのみをエクスポート対象とする
            If vbaModule.Type = vbext_ct_StdModule Then
                ' モジュールの拡張子を設定
                extension = ".bas"
                ' エクスポートするファイルパスを作成
                exportFilePath = exportPath & "\" & vbaModule.Name & extension
                ' モジュールを指定されたパスにエクスポート
                vbaModule.Export exportFilePath
            End If
        Next vbaModule
        ' エクスポート完了のメッセージを表示
        MsgBox "エクスポートが正常に完了しました。", , "処理結果"
    Else
        ' VBProjectにアクセスできなかった場合のエラーメッセージを表示
        MsgBox "VBProjectにアクセスできませんでした。", vbExclamation, "エラー"
    End If
    Exit Sub
    
エラー処理:
    ' エラーが発生した場合にエラーメッセージを表示
    MsgBox "エラーが発生しました: " & Err.Description, vbCritical, "エラー"
End Sub

そうして出力した標準モジュールは所定の場所に保存し、逆にWordを立ち上げた際に、標準テンプレートに取り込みます。
度々、保存失敗すると言っても、完全に保存していた標準モジュールがなくなる訳ではなく、同一名の標準モジュールの古いバージョンは残っている場合は、既存の標準モジュールを削除し、所定フォルダに保存した標準モジュールを新しくインポートすることにより差し替えます。

Sub sb標準テンプレート標準モジュール一括置換()
'標準テンプレートの標準モジュールを、所定フォルダ内から一括で置き換え（元々ない標準モジュールは新規インポート）
'参照設定：「Microsoft Scripting Runtime」（FileSystemObjectを使用するために必要）
    Dim fso As Scripting.FileSystemObject
    Dim fldr As Scripting.Folder
    Dim fl As Scripting.File
    Dim TargetPath As String
    Dim vbProj As Object
    Dim vbComp As Object
    Dim moduleName As String
 
    'レファレンス設定でMicrosoft Scripting Runtimeを追加
    Set fso = New Scripting.FileSystemObject
   
    '入れ替えたい標準モジュールの保存場所★可変箇所★
    TargetPath = "C:\Users\dummy\OneDrive\ドキュメント\マクロ関連\WordVBA\標準モジュールインポート"
   
    '選択したフォルダ内の.BASファイルのみ扱う。
    Set fldr = fso.GetFolder(TargetPath)
    
    'このドキュメント（標準テンプレート）のVBProjectを取得する。
    Set vbProj = ThisDocument.VBProject
 
    '指定したフォルダ内の各.BASファイルについて処理を行う。
    For Each fl In fldr.Files
        If Right(fl.Name, 4) = ".bas" Then
            moduleName = Left(fl.Name, Len(fl.Name) - 4)
           
            'もし既に同じ名前のモジュールが存在するならば、それを削除する。
            For Each vbComp In vbProj.VBComponents
                If vbComp.Name = moduleName Then
                    vbProj.VBComponents.Remove vbComp
                    Exit For
                End If
            Next vbComp
           
            '新たなモジュールをインポート
            vbProj.VBComponents.Import TargetPath & "\" & fl.Name
           
        End If
    Next fl
   
    Dim myMsg As String 'メッセージボックス用変数
    myMsg = "処理が終了しました。"
    MsgBox myMsg, , "処理結果通知"
   
End Sub

「sb標準テンプレート標準モジュール一括置換」自体は、標準テンプレート内の標準モジュールに保存して使用する前提であるため、「sb標準テンプレート標準モジュール一括置換」を記載している標準モジュール自体は差し替えから除外するように注意しましょう。
※標準モジュールの削除を行うコードを含むため、実行には十分注意してください。