【Access】アプリケーションタイトルの不具合(?)

Microsoft365のAccessを使用中にアプリケーションタイトルを設定することがありましたが、設定できない状況でしたので改善方法について書きたいと思います。
※この不具合は2022/10/05確認時は解消されていました。

アプリケーションタイトルとは

作成中のAccessファイルのタイトルです。通常、ファイル名やファイルパスがタイトルバーに表示されますが、アプリケーションタイトルを設定することでファイル名・ファイルパスの替りに設定したアプリケーション名がタイトルバーに表示されます。

不具合の内容について

「ファイル」→「オプション」で「Accessのオプション」画面が開きます。「現在のデータベース」から「アプリケーションタイトル」を設定しますが、キーボードを入力しても入力を受け付けません。

次にVBAで　CurrentDb.Propertiesに”AppTitle”が存在するか確認します。下記ロジックでAppTitleが存在しないことが確認できました。

Sub ListPropAppTitle()
    Dim strItem   As String
    Dim I      As Integer
    
    'データベースのプロパティに AppTitle は存在するか
    
    For I = 0 To CurrentDb.Properties.Count - 1 Step 1
        strItem = CurrentDb.Properties(I).Name
        Debug.Print strItem
    Next I
End Sub

CurrentDb.Properties”AppTitle”をVBAから設定

CurrentDb.Propertiesに”AppTitle”を設定します。この処理で「アプリケーションタイトル」が設定され、タイトルバーが設定されます。

Public Function MakeAppTitle()
    'アプリケーションタイトルを設定し、タイトルバーを再表示します。
    Dim blnRtn As Boolean
    Const DB_Text As Long = 10
    blnRtn = AddAppProperty("AppTitle", DB_Text, "アプリケーションタイトル")
    Application.RefreshTitleBar
End Function

Function AddAppProperty(strName As String, varType As Variant, varValue As Variant) As Boolean
    'データベースのプロパティを設定します。
    Dim dbs As Object, prp As Variant
    Const conPropNotFoundError = 3270
    
    Set dbs = CurrentDb
    On Error GoTo AddProp_Err
    dbs.Properties(strName) = varValue
    AddAppProperty = True
    
AddProp_Bye:
    Exit Function
    
AddProp_Err:
    If Err = conPropNotFoundError Then
        Set prp = dbs.CreateProperty(strName, varType, varValue)
        dbs.Properties.Append prp
        Resume
    Else
        AddAppProperty = False
        Resume AddProp_Bye
    End If
End Function

今後のために起動時にAutoExceマクロを設定しよう

まだ問題があります。アプリケーションタイトルを削除するとCurrentDb.Propertiesｍの”AppTitle”がまた削除されアプリケーションタイトルが設定できなくなるため、起動時にアプリケーションタイトルを設定します。AutoExecマクロを作成し、プロシージャの実行で「MakeAppTitle()」を入力することで実行できます。
※「MakeAppTitle()」は「CurrentDb.Properties”AppTitle”をVBAから設定」の章のプロシージャです。必ずsubではなくFunctionにします。