首先,新建一个模块，在模块中定义两个常量(来自微软帮助中的例程)：
Public Const DB_Text As Long = 10 ' 属性值为文本类型Public Const DB_Boolean As Long = 1 ' 属性值为逻辑类型
接下编写下列函数(此函数来自access帮助中)，以实现在数据库中添加或修改数据库属性。
| Public Function AddAppProperty(strName As String, varType As Variant, varvalue As Variant) As Integer'=============================================================================================' 本函数用来给当前数据库(.mdb)添加属性'' strName ： 属性名' varType ： 属性类型' varvalue： 属性的值'' 返回值 ： 成功 为 True (-1)' 失败 为 False (0)'' 例如：应用程序标题栏和应用程序图标' intX = AddAppProperty("AppTitle", DB_Text, "更改应用各标题栏和应用程序图标的例子")' intX = AddAppProperty("AppIcon", DB_Text, CurrentProject.Path & "\MSN.ico")' ' 应用设置' Application.RefreshTitleBar'' 易和软件：朱亦文 2002.05.01'=============================================================================================
Dim dbs As Object, prp As Variant Const conPropNotFoundError = 3270 ' 返回指向当前数据库的 Database 对象变量。 Set dbs = CurrentDb ' 如果是ADP，则为 CurrentProject 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 IfEnd Function |
然后编写更改access标题和图标的函数：
| Public Function ChangeMyaccessTitle(strTitle As String) As Integer ' 设置access主窗体的标题 ChangeMyaccessTitle = AddAppProperty("AppTitle", DB_Text, strTitle) Application.RefreshTitleBar ' 刷新标题栏，设置access的标题End Function |
| Public Function ChangeMyaccessIco(strIcoPath As String) As Integer ' 设置access主窗体的图标 ChangeMyaccessIco = AddAppProperty("AppIcon", DB_Text, strIcoPath) Application.RefreshTitleBar ' 刷新标题栏，设置access的图标End Function |
如果想要把 access 的图标改在 C:\my.ico, 则只要这样就可以了：
| iX = ChangeMyaccessIco("C:\my.ico") |
如果想要把 access 的标题改为“我的应用程序”，则只要这样：
| iX = ChangeMyaccessTitle("我的应用程序") |