Using VBA to Redirect the Links to the Back End

Our database-of-record uses 38 tables that are in five different back ends. When I move an updated front end from the sandbox directory to the production directory relinking the tables to the correct back end using the link manager was always a pain. I figured that there had to be a way to automate the process. Once I realized that I can use CurrentProject.Connection to determine which directory the front end was opened from it was just a matter of If-Then-Else logic.

I wrote the code as a public function and use an AutoExec macro to call it when the front end is opened.

Here is the code:

Public Function RelinkBackEnds()

'This function checks to see which directory the front end was opened from and

'redirects the table links to the proper back ends. Any front end opened from the

'\kheelstudent\ directory is a production front end and needs to be linked to the

'production back end in the \kheelstudent\ directory. Any front end opened from the

'\Kheel\ directory is a sandbox front end and needs to be linked to the

'production back end in the \Kheel\ sandbox. This code handles the redirecting without

'the user having to use the Linked Table Manager.

    Dim Dbs As Database

    Dim tblDef As TableDef

    Dim tblDefs As TableDefs

    Dim strNewPath As String

    Dim strBE As String

    Set Dbs = CurrentDb

   

    'Get the table definitions from the database.

    Set tblDefs = Dbs.TableDefs

    'Cycle through all the table definitions.

    For Each tblDef In tblDefs

    'Test the path to see if the database front end is in the \kheelstudent\ or \Kheel\ directory.

        If CurrentProject.Connection Like "*kheelstudent*" Then

        'If the database is in the \kheelstudent\ directory set the new path, strNewPath,

        'to the back end directory under \kheelstudent\.

        strNewPath = ";DATABASE=\\ilr.cornell.edu\ilr shared\Catherwood\kheelstudent\KIDB\BackEnds\"

        'Check to make sure that there is a table name in the table definition.

            If tblDef.SourceTableName <> "" Then

            'Debug.Print tblDef.Connect

            'For each path test for the presence of "sb" in the string. The sandbox back ends have the

            'suffix "sb" and are located in the \Kheel\ directory. The production back ends lack the

            'suffix "sb" and are located in the \kheelstudent\ directory.

                If tblDef.Connect Like "*sb*" Then

                'If the path string contains "sb" set the variable "strBE" to the

                'corresponding production back end.

                    If tblDef.Connect Like "*KIDBsb_be.accdb" Then

                        strBE = "KIDB_be.accdb"

                    ElseIf tblDef.Connect Like "*KDMTsb_be.accdb" Then

                        strBE = "KDMT_be.accdb"

                    ElseIf tblDef.Connect Like "*FolderListssb_be.accdb" Then

                        strBE = "FolderLists_be.accdb"

                    ElseIf tblDef.Connect Like "*Keywordsb_be.accdb" Then

                        strBE = "Keyword_be.accdb"

                    ElseIf tblDef.Connect Like "*KULPsb_be.accdb" Then

                        strBE = "KULP_be.accdb"

                    End If

                    'Debug.Print strBE

                'Construct the link path with the new path and the production back end.

                tblDef.Connect = NewPath & strBE

                'Debug.Print tblDef.Connect

                'Refresh the link.

                tblDef.RefreshLink

                Else:

                'If the path string does not contain "sb" then the front end is already linked to the

                'production back end.

                'Do nothing.

                End If

            'Reset the new path variable to a zero-length string.

            strNewPath = ""

            End If

        Else:

        'If the database is in the \Kheel\ directory set the new path, strNewPath,

        'to the back end directory under \Kheel\.

        strNewPath = ";DATABASE=\\ilr.cornell.edu\ilr shared\Catherwood\Kheel\Miles\Database\BackEnds\"

        'Check to make sure that there is a table name in the table definition.

           If tblDef.SourceTableName <> "" Then

            'Debug.Print tblDef.Connect

            'For each path test for the presence of "sb" in the string. The sandbox back ends have the

            'suffix "sb" and are located in the \Kheel\ directory. The production back ends lack the

            'suffix "sb" and are located in the \kheelstudent\ directory.

                If tblDef.Connect Like "*sb*" Then

                'If the path string contains "sb" then the front end is already linked to the

                'sandbox back end.

                'Do nothing.

                Else:

                'If the path string does not contain "sb" set the variable "strBE" to the

                'corresponding sandbox back end.

                    If tblDef.Connect Like "*KIDB_be.accdb" Then

                        strBE = "KIDBsb_be.accdb"

                    ElseIf tblDef.Connect Like "*KDMT_be.accdb" Then

                        strBE = "KDMTsb_be.accdb"

                    ElseIf tblDef.Connect Like "*FolderLists_be.accdb" Then

                        strBE = "FolderListssb_be.accdb"

                    ElseIf tblDef.Connect Like "*Keyword_be.accdb" Then

                        strBE = "Keywordsb_be.accdb"

                    ElseIf tblDef.Connect Like "*KULP_be.accdb" Then

                        strBE = "KULPsb_be.accdb"

                    End If

                    'Debug.Print strBE

                'Construct the link path with the new path and the production back end.

                tblDef.Connect = NewPath & strBE

                'Debug.Print Tdf.Connect

                'Refresh the link.

                tblDef.RefreshLink

                End If

            'Reset the new path variable to a zero-length string.

            strNewPath = ""

            End If

        End If

    'Move on to the next table definition.

    Next

End Function

Using VBA to require certain fields be filled in on an unbound form in MS Access.

On some of the data entry forms that I use there are fields (text box controls) that are required and others that are optional. Since I normally use unbound forms I can easily identify blank required fields and remind the user to fill them in.

On this form has three controls that are for required fields:

If the user leaves the Collection Number, the Scope/Content Note, or the Languages blank I need the code to identify the blank required fields and prompt the user to filled them in. This is pretty easily done by using the function Nz() to convert the null values from the required fields to “DataError” and the optional ones to a zero-length string.

In the On_Click event of the Save button (cmdSave_Click), after dimensioning the variables I pick up the values from the controls and use “DataError” to isolate where the user needs to add data:

    strCollNum = Nz(Me.txtCollNum, "DataError")

    strTitle = Nz(Me.txtTitle, "")

    strScopeContent = Nz(Me.txtScopeContent, "DataError")

    strType = Nz(Me.txtType, "")

    strFormat = Nz(Me.txtFormat, "")

    strExtent = Nz(Me.txtExtent, "")

    strDate = Nz(Me.txtDate, "")

    strLocation = Nz(Me.txtLocation, "")

    strRestrictions = Nz(Me.txtRestrictions, "")

    strRelation = Nz(Me.txtRelation, "")

    strLanguage = Nz(Me.txtLanguage, " DataError ")

    strSubjects = Nz(Me.txtSubjects, "")

    strKeywords = Nz(Me.txtKeywords, "")

    strNotes = Nz(Me.txtNotes, "")

        'Put the three required fields together in one string, strError.

        strError = strCollNum & strDesc & strLanguages

        'Test the strError to see if it contains DataError.

        If strError Like "*DataError*" Then

        'If strError contains DataError test each required field.

            If strCollNum Like "DataError" Then

            'For a DataError make the back color for the text box red.

                Me.txtCollNum.BackColor = RGB(255, 0, 0)

            Else:

            'Otherwise the back color for the text box should be the original blue.

                Me.txtCollNum.BackColor = RGB(199, 208, 227)

            End If

            If strDesc Like "DataError" Then

            'For a DataError make the back color for the text box red.

                Me.txtDescription.BackColor = RGB(255, 0, 0)

            Else:

            'Otherwise the back color for the text box should be the original blue.

                Me.txtDescription.BackColor = RGB(199, 208, 227)

            End If

            If strLanguages Like "DataError" Then

            'For a DataError make the back color for the text box red.

                Me.txtLanguage.BackColor = RGB(255, 0, 0)

            Else:

            'Otherwise the back color for the text box should be the original blue.

               Me.txtLanguage.BackColor = RGB(199, 208, 227)

            End If

            'Prompt the user to fill in the missing date and exit the sub.

            MsgBox "Red fields are required. Please complete form and re-save.", vbCritical

            Exit Sub       

       Else:

            'The code to write the data to the tables would go here to execute when all three 

             'required fields contain data.

      End If

Here is what the form looked like when I tried to save it after entering a collection number without a Scope/Content Note or Language.

Since the sub was exited after the message box was presented the user will be returned to the form when the message box is closed: the record cannot be saved unless the required fields contain data. Whether or not they contain valid data is another question, but using a similar set of tests the data can be validated and rejected if not valid.

Filling in folder numbers in an MS Excel container list.

Here at the Kheel Center we have quite a few legacy container lists in Excel spreadsheets that list the folder titles for each box, without giving the folder numbers.

A	B
Box	Folder Title
1	Folder 1
1	Folder 2
1	Folder 3
2	Folder 4
2	Folder 5
3	Folder 6
3	Folder 7

Before converting the container list to EAD I wanted to insert the folder numbers. I was able to do so using a fairly simple If-Then-Else statement. First insert a new column between the Box and Folder Title columns.

A	B	C
Box	Folder	Folder Title
1		Folder 1
1		Folder 2
1		Folder 3
2		Folder 4
2		Folder 5
3		Folder 6
3		Folder 7

In the first cell of the Folder column, cell B2, enter the following formula:

=IF(A2-A1=1,1,B1+1)

What this does is subtract A1 from B2, which will give you either a 1 or a 0. If the value is 1 then the current row is the first folder of the box. If the value is 0 then the current folder is the next folder in the box and should have a folder number that is one greater than the one above it. When you have the formula done double-click on the little handle at the lower right corner of the cell. This is the fill-down function and will run the formula down the entire column.

Note: this formula will give an error for all the folders in the first box: you are trying to subtract text (“Box”) from a number in the first cell.

A	B	C
Box	Folder	Folder Title
1	#VALUE!	Folder 1
1	#VALUE!	Folder 2
1	#VALUE!	Folder 3
2	1	Folder 4
2	2	Folder 5
3	1	Folder 6
3	2	Folder 7

To correct the error simply temporarily replace the “Box” in A1 with a zero.

A	B	C
0	Folder	Folder Title
1	1	Folder 1
1	2	Folder 2
1	3	Folder 3
2	1	Folder 4
2	2	Folder 5
3	1	Folder 6
3	2	Folder 7

Select column B and copy, then Paste Special=>Values right over it. This will convert the formulas in column B to the values shown. After that you can change cell A1 back to “Box”.

You now have a container list with both box and folder numbers.