Setting Application Icon Programatically 2

[idd]

This is a copy of thread
thread181-580926

I forgot to put a subject line in and so it appeared as

"HI, All I am using Access 2000" Which I dont think will be very helpful to anyone when they see it and will not inspire the right responses.



Hi all,

I am using Access 2000

I found some code which should allow my app to set the app icon when it loads up, assuming that it is in the same folder as the database. The reason for wanting to do this is so that when I distribute the db to other departments their path to the db and the icon file will not be the same as mine. SO I need it do it wherever a user keeps it as long as the icon file is in the same directory as the db.

unfortunately when I tried running the code it did not work becauseoff an error access 2000 threw up. It is possible that the code was written for Access 97, as the thread was back in 2001 about May time I think.

I was going to reference the thread here but my computer crashed and I cant seem to find the thread now.


the bit which causes the problem is

the code which reads


Set prp = dbs.CreateProperty(strPropName, _
PropType, varPropValue

in the function changeproperty

the problem it gives is type mismatch, i'm not knowledgeable enough to find out whats wrong can someone help ??

Idd

here is the code

--------------------------
start of code
-------------------------------------


Function SetStartupProperties()
'Set icon what location is same DB location's
ChangeProperty "AppIcon", dbText, DirOfFile & "staff lookup.ico"

End Function


'--------------------------------------------
'next function
'--------------------------------------------


Function ChangeProperty(strPropName As String, varPropType As Variant, varPropValue As Variant) As Integer
Dim dbs As Database, prp As Property
Const conPropNotFoundError = 3270

Set dbs = CurrentDb
On Error GoTo Change_Err
dbs.Properties(strPropName) = varPropValue
ChangeProperty = True

Change_Bye:
Exit Function

Change_Err:
If Err = conPropNotFoundError Then ' Property not found.
Set prp = dbs.CreateProperty(strPropName, _
PropType, varPropValue)
dbs.Properties.Append prp
Resume Next
Else
' Unknown error.
ChangeProperty = False
Resume Change_Bye
End If
End Function


'--------------------------------------------
'next function
'--------------------------------------------



Function DirOfFile(Optional strPath As String = "", Optional blnMasterDir As Boolean = False) As String
'Directory of file
DirOfFile = strPath
Dim i As Byte

If strPath = "" Then strPath = CurrentDb.Name

For i = 1 To Len(strPath)
If Mid(strPath, i, 1) = "\" Then
DirOfFile = Left(strPath, i)
If blnMasterDir = True Then
If i > 1 Then
If Mid(strPath, i - 1, 1) <> &quot;:&quot; Then
Exit For
End If
End If
End If
End If
Next i
End Function

 

[BillPower]

Hi this is one way to do it, this will make the Windows Help Icon the App Icon:

Dim dbs As DAO.Database, prpIcon As DAO.Property, strIcon As String
Dim strIcon As String
On Error GoTo ErrAppIcon
Set dbs = CurrentDb
Set prpIcon = dbs.CreateProperty(&quot;AppIcon&quot;, dbText, &quot;C:\windows\help.ico&quot
dbs.Properties.Append prpIcon
Application.RefreshTitleBar
dbs.Close
Exit Sub
ErrAppIcon:
MsgBox err.Number & &quot; ; &quot; & err.Description

Bill

 

[KornGeek]

billpower,
Not to nitpick, but you defined strIcon twice and aren't using it. I just wanted to point this out as a minor point of cleanup for the code.

That being said, thank you very much for that code. It never even occurred to me to try this. I've been trying to figure out how to set the icon, but I never thought to do it through code. You deserve a star for this.

 

[BillPower]

Hi KornGeek,

You're absolutely right to point something like this out.

I occassionally have the odd variable that becomes redundant, unfortuneately the compiler doesn't spot variables that are unused, but two?

I know whats happened, I've started listing my variables side by side, not one upon the other and forgot to delete one. And the other, I recently rewrote this function. Will watch out for this in future. I'm giving you a star for being so observant and your obviuos knowledge of VBA and most importantly bringing it to my attention.

Thanks

Bill

 

[idd]

Bill,

I have used your code with the function DirOfFile which I have shown in my post above.

so the set PRPIcon line looks like this

Set prpIcon = dbs.CreateProperty(&quot;AppIcon&quot;, dbText, DirOfFile & &quot;staff lookup.ico&quot

I have set an autoexec macro to run the code you supplied. It works well the first time but if I run it the second or any other times after the appIcon has been set, I get the following error message.


when I run the app
3367; cannot append. an object with that name already exists in the collection.

is there a way of checking to see that the AppIcon has not been set before trying to set it.

this way I can keep the autoexec macro and distribute the app knowing that the correct icon will always be used. I know that I can rename the macro and that way it will not get called again, but I want it to check if there is no icon assigned then it should assign the correct one.

thanks in advance

idd

 

[BillPower]

Hi idd,

Make your code look like this, Resume Next if there is an error. I had an error proc to inform the user that the icon didn't exist. But in reality it isn't really necessary.

Dim dbs As DAO.Database, prpIcon As DAO.Property, strIcon As String
Dim strIcon As String
On Error Resume Next
Set dbs = CurrentDb
Set prpIcon = dbs.CreateProperty(&quot;AppIcon&quot;, dbText, &quot;C:\windows\help.ico&quot
dbs.Properties.Append prpIcon
Application.RefreshTitleBar
dbs.Close
Exit Sub

Bill