Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Microsoft: Access Modules (VBA Coding) FAQ

Access Environment

Init StartUp and create your own copyright by hermanlaksko
Posted: 15 Oct 02 (Edited 9 Sep 03)

When ever I send out a newly created app. I sometimes forgot to incl. a ref to the app icon, not showing the database window etc. Clients would call me up and complain that a new window was there, and when they would close this window, the app would close on them, very annoying for them (and me)

And worst of all they were right
An error like this you only want to see once, if ever, so I created this little function to take care of this for me.

I incl. a ref to it in the the function that I use to start my app.

DAO/MDB solution:

Function CopyRight()
On Error GoTo Fejl
Dim DB As DAO.Database
Set DB = CurrentDb
CopyRight = DB.Properties!CopyRightNotice & " 2000" & " - " & Year(Now)

Exit Function

    If Err.Number <> 3270 Then MsgBox Err.Description , , Your App
    If Err.Number = 3270 Then CopyRightMake
    Resume Exit_Fejl
End Function

Function CopyRightMake()
'On Error Resume Next
Dim DB As DAO.Database
Dim P As Property
Set DB = DBEngine(0)(0)
Set P = DB.CreateProperty("CopyrightNotice", DB_TEXT, "¬ Your App")
DB.Properties.Append P
Set P = DB.CreateProperty("AppTitle", dbText, "Your App Name")
DB.Properties.Append P
Set P = DB.CreateProperty("AppIcon", dbText, "C:\Program Files\YourApp\Your.ico")
DB.Properties.Append P
Set P = DB.CreateProperty("StartUpShowDBWindow", dbBoolean, False)
DB.Properties.Append P
Set P = DB.CreateProperty("AllowBreakIntoCode", dbBoolean, False)
DB.Properties.Append P
Set P = DB.CreateProperty("AllowSpecialKeys", dbBoolean, False)
DB.Properties.Append P
Set P = DB.CreateProperty("AllowBuiltInToolbars", dbBoolean, False)
DB.Properties.Append P
Set P = DB.CreateProperty("AllowFullMenus", dbBoolean, False)
DB.Properties.Append P
Set P = DB.CreateProperty("AllowShortcutMenus", dbBoolean, False)
DB.Properties.Append P
Set P = DB.CreateProperty("AllowToolbarChanges", dbBoolean, False)
DB.Properties.Append P
End Function

ADO/ADP solution:

Function CopyRight()
Dim DBS As CurrentProject
On Error GoTo Fejl
Set DBS = Application.CurrentProject
CopyRight = DBS.Properties!CopyRightNotice & " 2000" & " - " & Year(Now)

    Exit Function
    If Err <> 3265 Then MsgBox Err.Description Else CopyRightMake
    Resume Exit_Fejl
End Function

Function CopyRightMake()
Dim DBS As CurrentProject
Dim prp As ADODB.Property
On Error GoTo ErrorHandler

Set DBS = Application.CurrentProject
'Try to set the property, if it fails, the property does not exist.

DBS.Properties("CopyRightNotice") = "¬ Your App"
DBS.Properties("AppTitle") = "Your App Name"
DBS.Properties("AppIcon") = "C:\Program Files\YourApp\Your.ico"
DBS.Properties("StartUpShowDBWindow") = False
DBS.Properties("AllowSpecialKeys") = False
DBS.Properties("AllowBuiltInToolbars") = False
DBS.Properties("AllowFullMenus") = False
DBS.Properties("AllowShortcutMenus") = False
DBS.Properties("AllowToolbarChanges") = False
   Set DBS = Nothing
   Set prp = Nothing
   Exit Function
   If Err = 2455 Then ' Create the new property.
      DBS.Properties.Add "CopyRightNotice", "¬ Your App"
      Resume Next
      Resume ExitLine
   End If
End Function
I drop my copyright notice on my main, if I use such, and in my "about" forms.

Back to Microsoft: Access Modules (VBA Coding) FAQ Index
Back to Microsoft: Access Modules (VBA Coding) Forum

My Archive

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close