Окно приложения MS Access - Заголовок и Иконка

Private Sub Test_App_Icon_and_Title()

Dim str As String

Dim i As Integer

On Error Resume Next

'Путь к файлу иконки

str = CurrentProject.Path & "\Application.ico"

'Установка иконки

AddAppProperty "AppIcon", dbText, str

Application.RefreshTitleBar

Err.Clear

'Установка названия приложения

str = "Пример НАЗВАНИЕ"

i = AddAppProperty("AppTitle", dbText, str)

Application.RefreshTitleBar

End Sub

Private Function AddAppProperty(strName As String, vType As Variant, val As Variant) As Integer

'Вспомогательная функция "AddAppProperty" изменяет - добавляет свойства БД

Dim dbs As Database, prp As Property

Const conPropNotFoundError = 3270

'--------------------------------------------------------------------

On Error GoTo AddAppPropertyErr

Set dbs = CurrentDb

dbs.Properties(strName) = val

AddAppProperty = True

AddAppPropertyBye:

Exit Function

AddAppPropertyErr:

If Err.Number = conPropNotFoundError Then

Set prp = dbs.CreateProperty(strName, vType, val)

dbs.Properties.Append prp

Else

AddAppProperty = False

MsgBox Err

End If

Err.Clear

Resume AddAppPropertyBye

End Function