VBA to change Application Icon in MSAccess

[KarenAnne]

I found some great code on this site to programmatically change AppIcon. (Sorry I can't find it again to properly credit the author.) It works great when my /wrkgrp user name is someone with admin rights, but if my /wrkgrp user name is someone without admin rights, it doesn't work:

Public Sub SetAppIcon(IconPath As String)
Dim db As DAO.Database, prp As DAO.Property

On Error GoTo GotErr

Set db = CurrentDb

db.Properties("AppIcon") = IconPath 'Attempt to assign
Application.RefreshTitleBar 'Update On Screen!

Exit Sub

GotErr:
If Err.Number = 3270 Then 'property doesn't exist!
Set prp = db.CreateProperty("AppIcon", dbText, IconPath)
db.Properties.Append prp 'New property set!
Else
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
End If

Resume Next

End Sub[/indent]

I have code elsewhere in the .mdb that temporarily changes the workspace to admin and links tables, but can't figure out how to use these commands in the code to change AppIcon above:

Public Function FindConnectStrings()
On Error GoTo Err_Handler


Dim wks As DAO.Workspace
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim strNEWLink As String

'Begin insert: Need to open connection as an admin to change properties. How do I use these in the code to change AppIcon?
Set wks = DBEngine.CreateWorkspace("", "AdminUserName", "AdminPwd")
Set db = wks.OpenDatabase(CurrentDb.Name)
'End insert
​

Set tdf = db.TableDefs("t_UserDefaults")
strNEWLink = ";DATABASE=" & Environ("appdata") & "\lp\lp_user.mdb"
tdf.Connect = strNEWLink
tdf.RefreshLink

 

[KarenAnne]

Can anyone help me?

 

[KarenAnne]

Here is the error message I get when I try the code logged in to /wrkgroup as someone without admin rights:

ERROR 3033:
YOU DO NOT HAVE THE NECESSARY PERMISSIONS TO USE THE MSysDb OBJECT.

 

[VBAPrincess]

I don't use workgroup permissions so I can't test what I'm going to suggest to you. Your SetAppIcon sub uses Set db = CurrentDb. Change it to:

Dim wks As DAO.Workspace
Dim db As DAO.Database
Dim prp As DAO.Property
Set wks = DBEngine.CreateWorkspace("", "AdminUserName", "AdminPwd")
Set db = wks.OpenDatabase(CurrentDb.Name)
db.Properties("AppIcon") = IconPath 'Attempt to assign
Application.RefreshTitleBar 'Update On Screen!

Hope this works for you or gets you closer to a solution!

Diana
VBA Princess
-- I'm hoping to grow up to be a Goddess!