full menus and allow toolbars changes

[Guest]

I have searched the forums for code to allow me to set full menus and allow
toolbar changes (like from Startup), but cannot find what I am looking for. I
want to set these properties on or off depending on certain values. I used to
have samples, but I cannot find them.

Any help would be much appreciated!

Thanks,
Clint

 

[Allen Browne]

This should give you most of the things you need:


Function StartupProps(bSet As Boolean)
'NOTE: For Access 2002, must to do this to prevent Access showing the db
window (kb 313915):
' Application.SetOption("ShowWindowsInTaskbar"), false

Dim db As DAO.Database
Dim strDB As String
Dim strPrp As String
strDb = "C:\\MyFile.mdb"
Set db = OpenDatabase(strDB)

' Application.SetOption "Track Name AutoCorrect Info", False
' Application.SetOption "Perform Name AutoCorrect", False
' Application.SetOption "Log Name AutoCorrect Changes", False

' ChangeProperty db, "StartupForm", dbText, "Customers"
' ChangeProperty db, "StartupShowDBWindow", dbBoolean, False
' ChangeProperty db, "StartupShowStatusBar", dbBoolean, False
' ChangeProperty db, "AllowBuiltinToolbars", dbBoolean, False
' ChangeProperty db, "AllowBreakIntoCode", dbBoolean, False
' Call ChangeProperty(db, "AllowFullMenus", dbBoolean, bSet)
Call ChangeProperty(db, "AllowSpecialKeys", dbBoolean, bSet)
Call ChangeProperty(db, "AllowBypassKey", dbBoolean, bSet)

db.Close
Set db = Nothing
End Function

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

On Error GoTo Change_Err
dbs.Properties(strPropName) = varPropValue
ChangeProperty = True
Debug.Print strPropName & " is " & varPropValue

Change_Bye:
Exit Function

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

 

[Guest]

Exactly what I needed!

Thanks a million,
Clint

This should give you most of the things you need:


Function StartupProps(bSet As Boolean)
'NOTE: For Access 2002, must to do this to prevent Access showing the db
window (kb 313915):
' Application.SetOption("ShowWindowsInTaskbar"), false

Dim db As DAO.Database
Dim strDB As String
Dim strPrp As String
strDb = "C:\\MyFile.mdb"
Set db = OpenDatabase(strDB)

' Application.SetOption "Track Name AutoCorrect Info", False
' Application.SetOption "Perform Name AutoCorrect", False
' Application.SetOption "Log Name AutoCorrect Changes", False

' ChangeProperty db, "StartupForm", dbText, "Customers"
' ChangeProperty db, "StartupShowDBWindow", dbBoolean, False
' ChangeProperty db, "StartupShowStatusBar", dbBoolean, False
' ChangeProperty db, "AllowBuiltinToolbars", dbBoolean, False
' ChangeProperty db, "AllowBreakIntoCode", dbBoolean, False
' Call ChangeProperty(db, "AllowFullMenus", dbBoolean, bSet)
Call ChangeProperty(db, "AllowSpecialKeys", dbBoolean, bSet)
Call ChangeProperty(db, "AllowBypassKey", dbBoolean, bSet)

db.Close
Set db = Nothing
End Function

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

On Error GoTo Change_Err
dbs.Properties(strPropName) = varPropValue
ChangeProperty = True
Debug.Print strPropName & " is " & varPropValue

Change_Bye:
Exit Function

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

 

[George Nicholson]

Keep in mind that changing some of these settings may not "take" until
the next time the db is opened.

In a general module:
*************************************
Dim g_bolInDesign as Boolean

Public Sub DbStartup()
gloInDesign = True
SetDAOObjectProperty CurrentDb, "StartupForm", dbText, "frmStartup"
SetDAOObjectProperty CurrentDb, "StartupShowDBWindow", dbBoolean,
g_bolInDesign
SetDAOObjectProperty CurrentDb, "StartupShowStatusBar", dbBoolean,
True
SetDAOObjectProperty CurrentDb, "AllowBuiltinToolbars", dbBoolean,
g_bolInDesign
SetDAOObjectProperty CurrentDb, "AllowToolbarChanges", dbBoolean,
g_bolInDesign
SetDAOObjectProperty CurrentDb, "AllowFullMenus", dbBoolean,
g_bolInDesign
SetDAOObjectProperty CurrentDb, "AllowShortcutMenus", dbBoolean,
True
SetDAOObjectProperty CurrentDb, "AllowSpecialKeys", dbBoolean,
g_bolInDesign
SetDAOObjectProperty CurrentDb, "AllowBreakIntoCode", dbBoolean,
False
SetDAOObjectProperty CurrentDb, "AllowBypassKey", dbBoolean,
g_bolInDesign
End Sub

Public Function SetDAOObjectProperty(objDAOObject As Variant, _
strPropName As String, varPropType As Variant, varPropValue As Variant)
As Integer
' Set properties of a DAO object (i.e., database, table, field).
' If property doesn't exist, it will be created.
' * Requires reference to DAO library

Dim prp As dao.Property
Const conPropNotFoundError As Integer = 3270

On Error GoTo ErrHandler
' Compare and change only if different
If objDAOObject.Properties(strPropName) <> varPropValue Then
objDAOObject.Properties(strPropName) = varPropValue
End If
SetDAOObjectProperty = True
ExitHere:
Set objDAOObject = Nothing
Set prp = Nothing
Exit Function
ErrHandler:
If Err = conPropNotFoundError Then
' Property not found: create it, append it
Set prp = objDAOObject.CreateProperty(strPropName, varPropType,
varPropValue)
objDAOObject.Properties.Append prp
Resume Next
Else
' Unknown error.
' * Function not included in post: Call ErrorLog(mDocName,
"SetDAOObjectProperty")
SetDAOObjectProperty = False
Resume ExitHere
End If
End Function
***************************************
HTH,