[COLOR="SeaGreen"]'Purpose: Modify existing Access database files to prevent bad modifications if clients open them with Access 2007.[/COLOR]
[COLOR="SeaGreen"]'Usage: To modify one file, import the code, and type this in the Immediate window:[/COLOR]
[COLOR="SeaGreen"]' ? PrepareDbFor2007)[/COLOR]
[COLOR="SeaGreen"]' To modify all MDB files in C:\MyFolder:[/COLOR]
[COLOR="SeaGreen"]' ? PrepareAllFor2007("C:\MyFolder", "*.MDB")[/COLOR]
[COLOR="SeaGreen"]'Notes: When a database is opened in Access 2007, users can add, delete, and rename fields in Datasheet view,[/COLOR]
[COLOR="SeaGreen"]' They can also modify forms and reports in Layout view.[/COLOR]
[COLOR="SeaGreen"]' This code sets the properties of the database so these new features are disabled.[/COLOR]
[COLOR="SeaGreen"]' It illustrates how to set other optional preferences as well.[/COLOR]
[COLOR="SeaGreen"]'Version: Run the code in Access 2000 or later.[/COLOR]
[COLOR="SeaGreen"]' (It works in Access 2007, but you do not need the new version to set these properties.)[/COLOR]
[COLOR="SeaGreen"]'Limits: Not designed for secured or replicated databases.[/COLOR]
[COLOR="SeaGreen"]'Author: Allen Browne (allen@allenbrowne.com), January 2007.[/COLOR]
[COLOR="SeaGreen"]'*******************************************[/COLOR]
[COLOR="SeaGreen"]'Set these constants to the values you want:[/COLOR]
[COLOR="SeaGreen"]'*******************************************[/COLOR]
[COLOR="SeaGreen"]'Don't allow fields to be added, deleted or renamed in Datasheet view.(Default is Allow.)[/COLOR]
[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Const[/COLOR] mbcAllowSchemaChanges [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Boolean[/COLOR] = False
[COLOR="SeaGreen"]'Don't allow users to modify design of forms and reports using the new Layout view. (Default is Allow.)[/COLOR]
[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Const[/COLOR] mlngcAllowLayoutView [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR] = 0&
[COLOR="SeaGreen"]'Disable Name AutoCorrect. Avoid bugs listed at http://allenbrowne.com/bug-03.html[/COLOR]
[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Const[/COLOR] mlngcPerformNameAutoCorrect [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR] = 0&
[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Const[/COLOR] mlngcTrackNameAutoCorrectInfo [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR] = 0&
[COLOR="SeaGreen"]'Disable Auto Compact[/COLOR]
[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Const[/COLOR] mlngcAutoCompact [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR] = 0&
[COLOR="SeaGreen"]'Use the new tabbed interface for open windows. (Default is to use over-lapping windows.)[/COLOR]
[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Const[/COLOR] mbtcUseOverlappingWindows [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Byte[/COLOR] = 0
[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Const[/COLOR] mbcShowDocumentTabs [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Boolean[/COLOR] = True
[COLOR="SeaGreen"]'Show the Nav Pane by Object Type, viewed as a list, sorted by name, with the Search bar.[/COLOR]
[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Const[/COLOR] mlngcNavPaneCategory [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR] = 0&
[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Const[/COLOR] mlngcNavPaneViewBy [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR] = 0&
[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Const[/COLOR] mlngcNavPaneSortBy [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR] = 0&
[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Const[/COLOR] mlngcShowNavPaneSearchBar [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR] = 1&
[COLOR="SeaGreen"]'Don't show #### for truncated numbers. (Default for converted databases, not new ones.)[/COLOR]
[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Const[/COLOR] mlngcCheckTruncatedNumFields [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR] = 0&
[COLOR="SeaGreen"]'Store as bitmaps for compatibility. (Default for converted databases, not new ones.)[/COLOR]
[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Const[/COLOR] mlngcPictureStorageCompatibility [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR] = 1&
[COLOR="Navy"]Sub[/COLOR] DO_IT_FROM_EXCEL()
[COLOR="Navy"]Dim[/COLOR] db [COLOR="Navy"]As[/COLOR] DAO.Database
[COLOR="Navy"]Set[/COLOR] db = DAO.DBEngine(0).OpenDatabase("C:\Database1.accdb")
[COLOR="Navy"]Call[/COLOR] PrepareDbFor2007(db)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
[COLOR="Navy"]Public[/COLOR] [COLOR="Navy"]Function[/COLOR] PrepareDbFor2007(Optional db [COLOR="Navy"]As[/COLOR] DAO.Database) [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="SeaGreen"]'Purpose: Set the properties of the database ready for Access 2007.[/COLOR]
[COLOR="SeaGreen"]'Argument: Database to set. Currentdb if not database passed in.[/COLOR]
[COLOR="SeaGreen"]'Return: Any warning messages if properties were not set.[/COLOR]
[COLOR="SeaGreen"]' Zero-length string if no errors.[/COLOR]
[COLOR="Navy"]Dim[/COLOR] strMsg [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR] [COLOR="SeaGreen"]'String to append error messages to.[/COLOR]
[COLOR="Navy"]Dim[/COLOR] bDbWasNothing [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Boolean[/COLOR]
[COLOR="SeaGreen"]' If db Is Nothing Then[/COLOR]
[COLOR="SeaGreen"]' bDbWasNothing = True[/COLOR]
[COLOR="SeaGreen"]' Set db = CurrentDb[/COLOR]
[COLOR="SeaGreen"]' End If[/COLOR]
[COLOR="SeaGreen"]'Essential changes.[/COLOR]
[COLOR="Navy"]Call[/COLOR] SetPropertyDAO(db, "AllowDatasheetSchema", dbBoolean, mbcAllowSchemaChanges, strMsg)
[COLOR="Navy"]Call[/COLOR] SetPropertyDAO(db, "DesignWithData", dbLong, mlngcAllowLayoutView, strMsg)
[COLOR="SeaGreen"]'Existing properties that should be set anyway.[/COLOR]
[COLOR="SeaGreen"]'Call SetPropertyDAO(db, "Perform Name AutoCorrect", dbLong, mlngcPerformNameAutoCorrect, strMsg)[/COLOR]
[COLOR="SeaGreen"]'Call SetPropertyDAO(db, "Track Name AutoCorrect Info", dbLong, mlngcTrackNameAutoCorrectInfo, strMsg)[/COLOR]
[COLOR="Navy"]Call[/COLOR] SetPropertyDAO(db, "Auto Compact", dbLong, mlngcAutoCompact, strMsg)
[COLOR="SeaGreen"]'Preferences for child windows.[/COLOR]
[COLOR="Navy"]Call[/COLOR] SetPropertyDAO(db, "UseMDIMode", dbByte, mbtcUseOverlappingWindows, strMsg)
[COLOR="Navy"]Call[/COLOR] SetPropertyDAO(db, "ShowDocumentTabs", dbBoolean, mbcShowDocumentTabs, strMsg)
[COLOR="SeaGreen"]'Preferences for the Navigation Pane.[/COLOR]
[COLOR="Navy"]Call[/COLOR] SetPropertyDAO(db, "Show Navigation Pane Search Bar", dbLong, mlngcShowNavPaneSearchBar, strMsg)
[COLOR="Navy"]Call[/COLOR] SetPropertyDAO(db, "NavPane Category", dbLong, mlngcNavPaneCategory, strMsg)
[COLOR="Navy"]Call[/COLOR] SetPropertyDAO(db, "NavPane View By", dbLong, mlngcNavPaneViewBy, strMsg)
[COLOR="Navy"]Call[/COLOR] SetPropertyDAO(db, "NavPane Sort By", dbLong, mlngcNavPaneSortBy, strMsg)
[COLOR="SeaGreen"]'Settings that default correctly if you convert a database, but are different from new ones in A2007.[/COLOR]
[COLOR="Navy"]Call[/COLOR] SetPropertyDAO(db, "CheckTruncatedNumFields", dbLong, mlngcCheckTruncatedNumFields, strMsg)
[COLOR="Navy"]Call[/COLOR] SetPropertyDAO(db, "Picture Property Storage Format", dbLong, mlngcPictureStorageCompatibility, strMsg)
[COLOR="SeaGreen"]'Clean up[/COLOR]
[COLOR="Navy"]If[/COLOR] bDbWasNothing [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Set[/COLOR] db = [COLOR="Navy"]Nothing[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
[COLOR="SeaGreen"]'Return any messages[/COLOR]
PrepareDbFor2007 = strMsg
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Function[/COLOR]
[COLOR="Navy"]Public[/COLOR] [COLOR="Navy"]Function[/COLOR] PrepareAllFor2007(Optional [COLOR="Navy"]ByVal[/COLOR] strPath [COLOR="Navy"]As[/COLOR] String, [COLOR="Navy"]Optional[/COLOR] strFileSpec [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR] = "*.mdb") [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="SeaGreen"]'Purpose: Set the properties for ALL databases matching the filespec.[/COLOR]
[COLOR="SeaGreen"]'Argument: File specification such as "C:\MyFolder\*.mdb"[/COLOR]
[COLOR="SeaGreen"]' You must include the extension.[/COLOR]
[COLOR="SeaGreen"]'Return: Number of files modified.[/COLOR]
[COLOR="SeaGreen"]'Note: There's no error handling. (Designed for developers.)[/COLOR]
[COLOR="Navy"]Dim[/COLOR] db [COLOR="Navy"]As[/COLOR] DAO.Database
[COLOR="Navy"]Dim[/COLOR] strFile [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] strMsg [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] lngKt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]If[/COLOR] strPath = vbNullString [COLOR="Navy"]Then[/COLOR]
strPath = CurDir$
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
strPath = TrailingSlash(strPath)
strFile = Dir(strPath & strFileSpec)
[COLOR="Navy"]If[/COLOR] strFile <> vbNullString [COLOR="Navy"]Then[/COLOR]
strMsg = "You are about to modify the properties ALL files matching:" & vbCrLf & strPath & strFileSpec
[COLOR="Navy"]If[/COLOR] MsgBox(strMsg, vbOKCancel + vbDefaultButton2 + vbQuestion, "PrepareAll()") = vbOK [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]Do[/COLOR] [COLOR="Navy"]While[/COLOR] strFile <> vbNullString
[COLOR="Navy"]Debug[/COLOR].[COLOR="Navy"]Print[/COLOR] strPath & strFile
[COLOR="Navy"]Set[/COLOR] db = OpenDatabase(strPath & strFile)
[COLOR="Navy"]Call[/COLOR] PrepareDbFor2007(db)
db.Close
[COLOR="Navy"]Set[/COLOR] db = [COLOR="Navy"]Nothing[/COLOR]
lngKt = lngKt + 1&
strFile = Dir
[COLOR="Navy"]Loop[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
PrepareAllFor2007 = lngKt
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Function[/COLOR]
[COLOR="Navy"]Public[/COLOR] [COLOR="Navy"]Function[/COLOR] ShowProps(obj [COLOR="Navy"]As[/COLOR] Object)
[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]GoTo[/COLOR] Err_Handler
[COLOR="SeaGreen"]'Purpose: Display the properties of the object in the immediate window.[/COLOR]
[COLOR="SeaGreen"]'Example: In the Immediate Window:[/COLOR]
[COLOR="SeaGreen"]' ? ShowProps(Currentdb)[/COLOR]
[COLOR="Navy"]Dim[/COLOR] prp [COLOR="Navy"]As[/COLOR] DAO.Property
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] prp [COLOR="Navy"]In[/COLOR] obj.Properties
[COLOR="Navy"]Debug[/COLOR].[COLOR="Navy"]Print[/COLOR] prp.Type,
[COLOR="Navy"]Debug[/COLOR].[COLOR="Navy"]Print[/COLOR] prp.Name,
[COLOR="Navy"]Debug[/COLOR].[COLOR="Navy"]Print[/COLOR] prp.Value;
[COLOR="Navy"]Debug[/COLOR].[COLOR="Navy"]Print[/COLOR]
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Set[/COLOR] prp = [COLOR="Navy"]Nothing[/COLOR]
Exit_Handler:
[COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Function[/COLOR]
Err_Handler:
[COLOR="Navy"]Select[/COLOR] [COLOR="Navy"]Case[/COLOR] Err.Number
[COLOR="Navy"]Case[/COLOR] 3219, 3267, 3251
[COLOR="Navy"]Resume[/COLOR] [COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Case[/COLOR] [COLOR="Navy"]Else[/COLOR]
MsgBox "Error " & Err.Number & " - " & Err.Description, vbExclamation, "ShowProps()"
[COLOR="Navy"]Resume[/COLOR] Exit_Handler
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Select[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Function[/COLOR]
[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Function[/COLOR] SetPropertyDAO(obj [COLOR="Navy"]As[/COLOR] Object, strPropertyName [COLOR="Navy"]As[/COLOR] String, intType [COLOR="Navy"]As[/COLOR] Integer, _
varValue [COLOR="Navy"]As[/COLOR] Variant, [COLOR="Navy"]Optional[/COLOR] strErrMsg [COLOR="Navy"]As[/COLOR] String) [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Boolean[/COLOR]
[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]GoTo[/COLOR] ErrHandler
[COLOR="SeaGreen"]'Purpose: Set a property for an object, creating if necessary.[/COLOR]
[COLOR="SeaGreen"]'Arguments: obj = the object whose property should be set.[/COLOR]
[COLOR="SeaGreen"]' strPropertyName = the name of the property to set.[/COLOR]
[COLOR="SeaGreen"]' intType = the type of property (needed for creating)[/COLOR]
[COLOR="SeaGreen"]' varValue = the value to set this property to.[/COLOR]
[COLOR="SeaGreen"]' strErrMsg = string to append any error message to.[/COLOR]
[COLOR="Navy"]If[/COLOR] HasProperty(obj, strPropertyName) [COLOR="Navy"]Then[/COLOR]
obj.Properties(strPropertyName) = varValue
[COLOR="Navy"]Else[/COLOR]
obj.Properties.Append obj.CreateProperty(strPropertyName, intType, varValue)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
SetPropertyDAO = True
ExitHandler:
[COLOR="Navy"]Exit[/COLOR] [COLOR="Navy"]Function[/COLOR]
ErrHandler:
strErrMsg = strErrMsg & obj.Name & "." & strPropertyName & " not set to " & varValue & _
". Error " & Err.Number & " - " & Err.Description & vbCrLf
[COLOR="Navy"]Resume[/COLOR] ExitHandler
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Function[/COLOR]
[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Function[/COLOR] HasProperty(obj [COLOR="Navy"]As[/COLOR] Object, strPropName [COLOR="Navy"]As[/COLOR] String) [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Boolean[/COLOR]
[COLOR="SeaGreen"]'Purpose: Return true if the object has the property.[/COLOR]
[COLOR="Navy"]Dim[/COLOR] varDummy [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Variant[/COLOR]
[COLOR="Navy"]On[/COLOR] [COLOR="Navy"]Error[/COLOR] [COLOR="Navy"]Resume[/COLOR] [COLOR="Navy"]Next[/COLOR]
varDummy = obj.Properties(strPropName)
HasProperty = (Err.Number = 0)
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Function[/COLOR]
[COLOR="Navy"]Private[/COLOR] [COLOR="Navy"]Function[/COLOR] TrailingSlash(varIn [COLOR="Navy"]As[/COLOR] Variant) [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]If[/COLOR] Len(varIn) > 0 [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]If[/COLOR] Right(varIn, 1) = "\" [COLOR="Navy"]Then[/COLOR]
TrailingSlash = varIn
[COLOR="Navy"]Else[/COLOR]
TrailingSlash = varIn & "\"
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Function[/COLOR]