トップ　>　汎用コード　>　ビルトインドキュメントプロパティの一括設定

Sub All_Books_SetBIDP() '実行用マクロ
 'フォルダ内全てのブックを対象にビルトインドキュメントプロパティを設定
    Dim strDirPath As String
    
    'フォルダの選択
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then strDirPath = .SelectedItems(1)
    End With
    If Len(strDirPath) = 0 Then Exit Sub
    
    'フォルダの存在確認
    If Dir(strDirPath, vbDirectory) = "" Then Exit Sub
    
    'フォルダ内ブック検索・ドキュメントプロパティ設定
    Call Search_Books(strDirPath)
    
End Sub

Private Sub Search_Books(ByVal strPath As String) 'フォルダ内ブック検索
    Dim strTarget      As String
    Dim strAppUserName As String
    
    Const USN          As String = "坂江保" '項目「前回保存者」用

    With Application
        strPath = strPath & .PathSeparator  'フォルダパスにフォルダ区切り文字追加
        strTarget = Dir(strPath & "*.xls?") 'フォルダ内のExcelブックを検索
        If strTarget = "" Then Exit Sub     'ブックがなければ終了
        .ScreenUpdating = False             '画面更新停止
        .DisplayAlerts = False              '確認メッセージ非表示
        strAppUserName = .UserName          'アプリケーションのユーザー名を取得
        .UserName = USN                     'アプリケーションのユーザー名を設定
        On Error Resume Next
            Do
                With .Workbooks.Open(strPath & strTarget)
                    Call Set_BID_Property
                    .Save
                    .Close
                End With
                strTarget = Dir()           '次のExcelブックを検索
            Loop Until strTarget = ""       'ブックがなければループから抜ける
        On Error GoTo 0
        .UserName = strAppUserName          'アプリケーションのユーザー名を戻す
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    strTarget = Dir("")
End Sub

Sub Set_BID_Property() '各項目設定
    With ActiveWorkbook
        .BuiltinDocumentProperties(1).Value = "BIDPサンプル"             'タイトル
        .BuiltinDocumentProperties(2).Value = "サブタイトル"             'サブタイトル
        .BuiltinDocumentProperties(3).Value = "坂江保"                   '作成者
        .BuiltinDocumentProperties(4).Value = "Excel"                    'キーワード
        .BuiltinDocumentProperties(18).Value = "Office2019"              '分類項目
        .BuiltinDocumentProperties(5).Value = "コメントです"             'コメント
        .BuiltinDocumentProperties(8).Value = "2"                        '改訂番号
        .BuiltinDocumentProperties(20).Value = "特記事項無し"            'マネージャー
        .BuiltinDocumentProperties(21).Value = "Excel Tips for Learners" '会社名
    End With
End Sub