runtime error 3270 when attempting to assign custom icon

[Brian G via AccessMonster.com]

Hi all, hopefully someone can help me....

This code poops out at
db.Properties("AppIcon") = strFile
and gives me a runtime 3270 error Property not found
there is definitely a value being passed (strFile = "C:\dbBuild\myicon.ico")

-------------
DoCmd.Maximize
DoCmd.ShowToolbar "Menu Bar", acToolbarNo
Dim stDocName As String
Dim stLinkCriteria As String

Dim db As DAO.Database
Dim strFile As String
Dim strDbFile As String
Dim strDbPath As String


'Get the path of the database
Set db = DBEngine(0)(0)

strDbPath = db.Name
strDbFile = Dir(strDbPath)
strDbDir = Left(strDbPath, Len(strDbPath) - Len(strDbFile))

strFile = strDbDir & "VP.ico"

'Check the icon file exists.
If Len(Dir$(strFile)) > 0 Then
db.Properties("AppIcon") = strFile
Application.RefreshTitleBar
End If

Set db = Nothing

 

[Alex Dybenko]

Hi,
here how i run it, you have to create a property if does not exists:

Function StartUpProperties()
Const conPropNotFoundError = 3270

On Error GoTo AddProp_Err
CurrentDb.Properties("AppIcon") = "C:\dbBuild\myicon.ico")
Application.RefreshTitleBar

StartUpProperties_End:
Exit Function

StartUpProperties_Err:
If Err = conPropNotFoundError Then
CurrentDb.Properties.Append CurrentDb.CreateProperty("AppIcon",
dbText, "C:\dbBuild\myicon.ico")
Resume
Else
Resume StartUpProperties_End
End If

end function

 

[Brian G via AccessMonster.com]

Thanks Alex but I would really like to deal with it from within my Sub.

Also the call to change the properties is a dynamic one because this is an
application that will be distributed to a number of network users and I
really won't know what drive or folder the icon will end up in.

I am hoping I am simply missing one key element, although my searches in the
group all come up with very similar code.

 

[Douglas J. Steele]

So have a "helper function" that you call from your existing sub.

Based on an example in the Help file:

Sub SetAppIconProperty(strIconFile As String)
On Error GoTo Err_SetAppIconProperty

Dim dbCurr As DAO.Database
Dim prpNew As DAO.Property
Dim errLoop As Error

Set dbCurr = CurrentDb()
' Attempt to set the specified property.
dbCurr.Properties("AppIcon") = strIconFile

End_SetAppIconProperty:
Set dbCurr = Nothing
Exit Sub

Err_SetAppIconProperty:

' Error 3270 means that the property was not found.
If Err.Number = 3270 Then
' Create property, set its value, and append it to the
' Properties collection.
Set prpNew = dbCurr.CreateProperty( _
"AppIcon", dbText, strIconFile)
dbCurr.Properties.Append prpNew
Else
' If different error has occurred, display message.
MsgBox "Error number: " & Err.Number & vbCr & _
Err.Description
End If
Resume End_SetAppIconProperty

End Sub

 

[Brian G via AccessMonster.com]

Sorry Alex, quite new to this and I should have paid your response more
attention. Your solution works wonderfully.

Appreciate the quick response.