access 2007 vba bible phần 8 pot

On Error Resume Next DoCmd.RunCommand acCmdSizeToFitForm On Error GoTo ErrorHandler intChoice = Nz(Me![BackupChoice], 2) Select Case intChoice Case 1 Me![cmdCustomBackupPath].Enabled = False Case 2 Me![cmdCustomBackupPath].Enabled = False Case 3 Me![cmdCustomBackupPath].Enabled = True End Select ErrorHandlerExit: Exit Sub ErrorHandler: MsgBox “Error No: “ & err.Number _ & “; Description: “ & err.Description Resume ErrorHandlerExit End Sub Private Sub fraBackupOptions_AfterUpdate() On Error GoTo ErrorHandler intChoice = Nz(Me![fraBackupOptions].Value, 2) strBackupChoice = CStr(intChoice) strBackupPath = Nz(Me![BackupPath]) Select Case intChoice Case 1 Me![cmdCustomBackupPath].Enabled = False Case 2 Me![cmdCustomBackupPath].Enabled = False Case 3 Me![cmdCustomBackupPath].Enabled = True End Select 485 Creating Access Add-ins 14 20_047026 ch14.qxp 4/2/07 9:54 PM Page 485 Save the user’s choice to a database property in the calling database. Set dbsCalling = CurrentDb strPropName = “BackupChoice” Call SetProperty(strName:=strPropName, _ lngType:=dbText, varValue:=strBackupChoice) ErrorHandlerExit: Exit Sub ErrorHandler: MsgBox “Error No: “ & err.Number _ & “; Description: “ & err.Description Resume ErrorHandlerExit End Sub basExtras Module The basExtras standard module contains functions that are called from the USysRegInfo table: Public Function ExtrasOptions() ‘Called from USysRegInfo (menu add-in) On Error GoTo ErrorHandler Dim strBackEndSyntaxChoice As String Dim strBackEndSyntax As String Dim strBackEndPathChoice As String Dim strBackEndPath As String Dim strDefault As String Get info from database properties in the calling database, and write them to zstblBackupChoices in the code database for use as form’s record source: Set dbsCalling = CurrentDb strPropName = “BackupChoice” strDefault = “2” strBackupChoice = GetProperty(strPropName, strDefault) Debug.Print “Backup choice: “ & strBackupChoice strPropName = “BackupPath” strDefault = “” strBackupPath = GetProperty(strPropName, strDefault) Debug.Print “Backup path: “ & strBackupPath strTable = “zstblBackupChoice” Set dbsCode = CodeDb Set rst = dbsCode.OpenRecordset(strTable) 486 Adding More Functionality to Office Part III 20_047026 ch14.qxp 4/2/07 9:54 PM Page 486 rst.MoveFirst rst.Edit rst![BackupChoice] = strBackupChoice rst![BackupPath] = strBackupPath rst.Update rst.Close On Error Resume Next Copy the zstblBackupInfo table to the calling database, if needed: strCallingDb = CurrentDb.Name strTable = “zstblBackupInfo” Set tdfsCalling = dbsCalling.TableDefs Set tdfCalling = tdfsCalling(strTable) If tdfCalling Is Nothing Then Debug.Print strTable & “ not found; about to copy it” DoCmd.CopyObject destinationdatabase:=strCallingDb, _ newname:=strTable, _ sourceobjectType:=acTable, _ sourceobjectname:=strTable Debug.Print “Copied “ & strTable End If Open the dialog form for selecting options: strForm = “fdlgSetExtrasOptions” DoCmd.OpenForm FormName:=strForm, _ view:=acNormal, _ windowmode:=acDialog ErrorHandlerExit: Exit Function ErrorHandler: MsgBox “Error No: “ & err.Number _ & “; Description: “ & err.Description Resume ErrorHandlerExit End Function Public Function CopyListObjects() ‘Called from listTableFields() and ListQueryFields() On Error Resume Next Dim ctr As DAO.Container Dim doc As DAO.Document 487 Creating Access Add-ins 14 20_047026 ch14.qxp 4/2/07 9:54 PM Page 487 Copy various objects to the calling database, if they don’t already exist. These objects are needed to support the add-in’s functionality: Set dbsCalling = CurrentDb strCallingDb = CurrentDb.Name Set tdfsCalling = dbsCalling.TableDefs strTable = “zstblAccessDataTypes” Set tdfCalling = tdfsCalling(strTable) DoCmd.SetWarnings False If tdfCalling Is Nothing Then Debug.Print strTable & “ not found; about to copy it” DoCmd.CopyObject destinationdatabase:=strCallingDb, _ newname:=strTable, _ sourceobjectType:=acTable, _ sourceobjectname:=strTable End If Set ctr = dbsCalling.Containers(“Reports”) strReport = “zsrptTableAndFieldNames” Set doc = ctr.Documents(strReport) If doc Is Nothing Then DoCmd.CopyObject destinationdatabase:=strCallingDb, _ newname:=strReport, _ sourceobjectType:=acReport, _ sourceobjectname:=strReport End If strReport = “zsrptQueryAndFieldNames” Set doc = ctr.Documents(strReport) If doc Is Nothing Then DoCmd.CopyObject destinationdatabase:=strCallingDb, _ newname:=strReport, _ sourceobjectType:=acReport, _ sourceobjectname:=strReport End If ErrorHandlerExit: Exit Function ErrorHandler: MsgBox “Error No: “ & err.Number _ & “; Description: “ & err.Description Resume ErrorHandlerExit End Function 488 Adding More Functionality to Office Part III 20_047026 ch14.qxp 4/2/07 9:54 PM Page 488 Back up Database The BackupFrontEnd function is called from the USysRegInfo table to back up the current data- base to the path selected in the Extra Options dialog: Public Function BackupFrontEnd() ‘Called from USysRegInfo On Error GoTo ErrorHandler Set dbsCalling = CurrentDb Set tdfsCalling = dbsCalling.TableDefs Set fso = CreateObject(“Scripting.FileSystemObject”) strCurrentDB = Application.CurrentProject.Name Debug.Print “Current db: “ & strCurrentDB intExtPosition = InStr(strCurrentDB, “.”) strExtension = Mid(strCurrentDB, intExtPosition) intExtLength = Len(strExtension) Create the backup path string depending on the user’s choice, with a default of 2 (“Backups folder under the database folder”) in case the user has not made a choice: strPropName = “BackupChoice” strBackupChoice = GetProperty(strPropName, “2”) Debug.Print “Backup choice: “ & strBackupChoice strPropName = “BackupPath” strPath = GetProperty(strPropName, “”) Debug.Print “Custom backup path: “ & strPath Select Case strBackupChoice Case “1” Same folder as database strBackupPath = _ Application.CurrentProject.Path & “\” Case “2” Backups folder under database folder strBackupPath = _ Application.CurrentProject.Path & “\Backups\” Case “3” 489 Creating Access Add-ins 14 20_047026 ch14.qxp 4/2/07 9:54 PM Page 489 Custom folder strBackupPath = strPath & “\” End Select Debug.Print “Backup path: “ & strBackupPath Check whether the path is valid. On Error Resume Next Set sfld = fso.GetFolder(strBackupPath) If sfld Is Nothing Then If strBackupChoice = “3” Then strTitle = “Invalid path” strPrompt = strBackupPath _ & “ is an invalid path; please select “ _ & “another custom path” MsgBox strPrompt, vbOKOnly + vbExclamation, strTitle GoTo ErrorHandlerExit ElseIf strBackupChoice = “2” Then Create folder. Set sfld = fso.CreateFolder(strBackupPath) End If End If If setup has not been done, copy zstblBackupInfo to the calling database: strCallingDb = CurrentDb.Name strTable = “zstblBackupInfo” Set tdfCalling = dbsCalling.TableDefs(strTable) If tdfCalling Is Nothing Then Debug.Print strTable & “ not found; about to copy it” DoCmd.CopyObject destinationdatabase:=strCallingDb, _ newname:=strTable, _ sourceobjectType:=acTable, _ sourceobjectname:=strTable Debug.Print “Copied “ & strTable End If Create a proposed save name for the backup database file: strDayPrefix = Format(Date, “mm-dd-yyyy”) strSaveName = Left(strCurrentDB, _ Len(strCurrentDB) - intExtLength) & “ Copy “ & SaveNo _ & “, “ & strDayPrefix & strExtension 490 Adding More Functionality to Office Part III 20_047026 ch14.qxp 4/2/07 9:54 PM Page 490 strProposedSaveName = strBackupPath & strSaveName Debug.Print “Backup save name: “ & strProposedSaveName strTitle = “Database backup” strPrompt = “Save database to “ & strProposedSaveName _ & “?” strSaveName = Nz(InputBox(prompt:=strPrompt, _ title:=strTitle, Default:=strProposedSaveName)) Deal with user canceling out of the InputBox. If strSaveName = “” Then GoTo ErrorHandlerExit End If Set rst = dbsCalling.OpenRecordset(“zstblBackupInfo”) With rst .AddNew ![SaveDate] = Format(Date, “d-mmm-yyyy”) ![SaveNumber] = SaveNo .Update .Close End With fso.CopyFile Source:=CurrentDb.Name, _ destination:=strSaveName ErrorHandlerExit: Exit Function ErrorHandler: MsgBox “Error No: “ & err.Number & “; Description: “ & _ err.Description Resume ErrorHandlerExit End Function Back up Back End Database The BackupBackEnd function is called from the USysRegInfo table to back up the current data- base’s back end (if there is one) to the path selected in the Extra Options dialog: Public Function BackupBackEnd() ‘Called from USysRegInfo On Error GoTo ErrorHandler Dim strBackEndDBNameAndPath As String Dim strBackEndDBName As String Dim strBackEndDBPath As String Dim strFilePath As String 491 Creating Access Add-ins 14 20_047026 ch14.qxp 4/2/07 9:54 PM Page 491 Dim strFullDBName As String Dim strFileName As String Dim strFullPath() As String Dim strDBName As String Dim intUBound As Integer Dim strConnect As String Set dbsCalling = CurrentDb Set tdfsCalling = dbsCalling.TableDefs Set fso = CreateObject(“Scripting.FileSystemObject”) strCurrentDB = Application.CurrentProject.Name Debug.Print “Current db: “ & strCurrentDB strDayPrefix = Format(Date, “mm-dd-yyyy”) intExtPosition = InStr(strCurrentDB, “.”) strExtension = Mid(strCurrentDB, intExtPosition) intExtLength = Len(strExtension) strExcludeTable = “zstblTablePrefixes” Create backup path string depending on user choice. strPropName = “BackupChoice” strBackupChoice = GetProperty(strPropName, “2”) Debug.Print “Backup choice: “ & strBackupChoice strPropName = “BackupPath” strPath = GetProperty(strPropName, “”) Debug.Print “Custom backup path: “ & strPath Check whether there are any linked tables, and exit if not. strBackEndDBNameAndPath = “” On Error Resume Next Get back end database name from Connect property of a table. For Each tdfCalling In tdfsCalling strTable = tdfCalling.Name Debug.Print “Table name: “ & strTable strConnect = Nz(tdfCalling.Connect) Debug.Print “Connect property: “ & strConnect If strConnect <> “” Then strBackEndDBNameAndPath = Mid(strConnect, _ InStr(strConnect, “=”) + 1) Debug.Print “Back end db name and path: “ _ & strBackEndDBNameAndPath GoTo ContinueBackup End If Next tdfCalling On Error GoTo ErrorHandler 492 Adding More Functionality to Office Part III 20_047026 ch14.qxp 4/2/07 9:54 PM Page 492 No linked tables found. strTitle = “No back end” strPrompt = “There are no linked tables in this database; “ _ & “please use the Back up Database command instead” MsgBox strPrompt, vbExclamation + vbOKOnly, strTitle GoTo ErrorHandlerExit ContinueBackup: Extract back end name and path from Connect property string. strFullPath = Split(strBackEndDBNameAndPath, “\”, -1, _ vbTextCompare) intUBound = UBound(strFullPath) strBackEndDBName = strFullPath(intUBound) strBackEndDBPath = Mid(strBackEndDBNameAndPath, 1, _ Len(strBackEndDBNameAndPath) - Len(strBackEndDBName)) Debug.Print “Database name: “ & strBackEndDBName Debug.Print “Database path: “ & strBackEndDBPath On Error Resume Next Check whether back end path is valid. Set sfld = fso.GetFolder(strBackEndDBPath) If sfld Is Nothing Then strTitle = “Invalid path” strPrompt = strBackEndDBPath _ & “ is an invalid path; please re-link tables and try again” MsgBox strPrompt, vbOKOnly + vbExclamation, strTitle GoTo ErrorHandlerExit End If If setup has not been done, copy zstblBackupInfo to calling database. strCallingDb = CurrentDb.Name strTable = “zstblBackupInfo” Set tdfCalling = dbsCalling.TableDefs(strTable) If tdfCalling Is Nothing Then Debug.Print strTable & “ not found; about to copy it” DoCmd.CopyObject destinationdatabase:=strCallingDb, _ newname:=strTable, _ sourceobjectType:=acTable, _ sourceobjectname:=strTable Debug.Print “Copied “ & strTable End If 493 Creating Access Add-ins 14 20_047026 ch14.qxp 4/2/07 9:54 PM Page 493 Select Case strBackupChoice Case “1” Same folder as back end database strBackupPath = strBackEndDBPath Case “2” Backups folder under back end database folder strBackupPath = strBackEndDBPath & “Backups\” Case “3” Custom folder strBackupPath = strPath End Select Debug.Print “Backup path: “ & strBackupPath On Error Resume Next Recheck whether selected path is valid. Set sfld = fso.GetFolder(strBackupPath) If sfld Is Nothing Then If strBackupChoice = “3” Then strTitle = “Invalid path” strPrompt = strBackupPath _ & “ is an invalid path; please select another custom path” MsgBox strPrompt, vbOKOnly + vbExclamation, strTitle GoTo ErrorHandlerExit ElseIf strBackupChoice = “2” Then Create folder. Set sfld = fso.CreateFolder(strBackupPath) End If End If On Error GoTo ErrorHandler Create proposed save name for backup. strDayPrefix = Format(Date, “mm-dd-yyyy”) strSaveName = Left(strBackEndDBName, _ 494 Adding More Functionality to Office Part III 20_047026 ch14.qxp 4/2/07 9:54 PM Page 494 [...]... of Access (it doesn’t need any special new features of Access 2007, and doesn’t create menus or toolbars that will only work in older versions), create the add-in in an older format, so it can run in both the older version(s) and Access 2007 The LNC Rename.mda add-in will run in any version of Access from Access 2000 through Access 2007, at least if you are running on Windows XP TIP 510 Creating Access. .. Extensibility in Access 2007: http://msdn2.microsoft.com/en-us/ library/bb 187 3 98. aspx n Transitioning Your Existing Access Applications to Access 2007: http://msdn2 microsoft.com/en-us/library/bb20 384 9.aspx n Erik Rucker’s blog: http://blogs.msdn.com /access n Jensen Harris’ blog: http://blogs.msdn.com/jensenh/default.aspx n Patrick Schmid’s blog: http://pschmid.net/blog/2006/10/09/ 58 n Third of Five Blog:... previous Access database formats as well as Access 2007) Access add-ins let you encapsulate a set of database objects (primarily code and forms), for use in any Access database, as a way of adding extra functionality to a database without the need to manually import objects into any database where you need the functionality The next chapter covers using Ribbon XML to work with the Access ribbon, in Access. .. your add-ins, as shown in Figure 14.17 5 08 Creating Access Add-ins Next, open any Access database, and select the Database Tools tab of the Ribbon, click the Add-Ins drop-down in the Database Tools group, and select Add-In Manager (see Figure 14. 18) FIGURE 14.17 Adding a folder to the Trusted Locations group FIGURE 14. 18 Opening the Add-In Manager in Access 2007 Once you have opened the Add-In Manager,... Patrick Schmid on Access 2007 Ribbon Customizability T he best discussion of Access 2007 Ribbon customizability (or the lack thereof) is from the October 18, 2006 entry on MVP Patrick Schmid’s blog: If you ask me about the customizability of the new Ribbon UI in Office 2007, my answer would be: too little, too difficult Compared to previous Office versions, especially Office 2003, 2007 simply has a... lists tables and their fields instead of queries and their fields Access add-ins, once you have learned the special techniques needed to create them, are a great way of enhancing your Access databases with extra functionality, even supporting multiple versions of Access Summary This chapter dealt with creating Access add-ins in the Access 2007 (.accda) library database format (you can use the same techniques... Editor or XML Notepad 2007, so I would recommend using one of those editors instead 5 18 Customizing the Ribbon with XML in Access Databases and Add-ins If you have Visual Studio 2005 (any edition), use its built-in XML editor; otherwise, I recommend the XML Notepad 2007 editor for working with XML code FIGURE 15.3 XML code in the Office 2007 Custom UI Editor Customizing the Ribbon in an Access Database If... to add tabs, groups, or controls to the Ribbon in an Access database, you have to write XML and (optionally) VBA code — unlike customizing toolbars and menus, you can’t just drag a command to a location on any toolbar or menu, as in previous versions of Access The only manual customization available in Access 2007 is adding commands to the Quick Access Toolbar In a major change from previous versions... close Access 2 Open the library database, fix any errors, and compile the add-in database 3 Repeat as needed until the add-in runs without errors Installing an Add-in An add-in only needs to be installed once in any Access database; after it is installed, it is available to all Access databases To install the Extras 2007 add-in, first copy the library database to your AddIns folder In Access 2007 running... project 1 Open a module in any Access database, and select Tools, References to open the References dialog, as shown in Figure 14.11 FIGURE 14.11 The References dialog in Access 2007 504 Creating Access Add-ins 2 Click the Browse button to browse for the add-in library database, and select Add-ins (*.mda) in the Files of Type drop-down list, if you are setting a reference to an Access 2003 or earlier (.mda) . err.Description Resume ErrorHandlerExit End Function 488 Adding More Functionality to Office Part III 20_047026 ch14.qxp 4/2/07 9:54 PM Page 488 Back up Database The BackupFrontEnd function is called. Resume Next Dim ctr As DAO.Container Dim doc As DAO.Document 487 Creating Access Add-ins 14 20_047026 ch14.qxp 4/2/07 9:54 PM Page 487 Copy various objects to the calling database, if they don’t. False Case 3 Me![cmdCustomBackupPath].Enabled = True End Select 485 Creating Access Add-ins 14 20_047026 ch14.qxp 4/2/07 9:54 PM Page 485 Save the user’s choice to a database property in the calling