This article describes how to open a Microsoft Access form at a specific record from a Visio shape. I was an Access developer before I was a Visio developer, and both of the applications have VBA to provide tactical solutions for everyday tasks. Fortunately, it is fairly simple to copy the VBA code from one application to another…
Firstly, I am assuming that both of the desktop applications are open, and although Visio shapes can be linked to Access queries and tables, it is not essential for this solution.
The Access database
Access databases currently come in two forms, desktop and web, but this is for the older desktop type ( *.accdb or *.mdb ). In my example database, I have just three tables, Departments; Master_Shapes and Personnel, that have been derived from the Org_Data.xls workbook that is installed by Visio. I have added a query, queryPersonnel, that joins these three tables together. I then created a bound form based on queryPersonnel called Personnel. Finally, I created another unbound for, SelectPerson, so that I can select a person record from a listbox row, using the query queryPersonnel, to test the type of actions that I would like to do in Visio.
The buttons open the Personnel form with a particular filter applied:
- Edit Person – use the integer ID column
- Edit Department Personnel – use the string DepartmentID (demonstrates how to get around the lookup column problem).
- Edit Title Personnel – use the string Title column
- Edit Start Date Personnel – use the datetime Start_Date column
I initially created the first button using the default Embedded Macro function, but then I converted the macro to VBA using the Convert Form’s Macros to Visual Basic button that is hidden by default.
Opening a form filtered by a numeric column
The VBA for the first button, CommandOpenPerson, is:
Private Sub CommandOpenPerson_Click() On Error GoTo CommandOpenPerson_Click_Err If (ListPersonnel.ListIndex > -1) Then DoCmd.OpenForm "Personnel", acNormal, "", "[ID]=" & _ ListPersonnel, , acNormal Else Beep MsgBox "Please select a person first", vbOKOnly, "Edit Person ?" End If CommandOpenPerson_Click_Exit: Exit Sub CommandOpenPerson_Click_Err: MsgBox Error$ Resume CommandOpenPerson_Click_Exit End Sub
This is simple because the data type of ID is integer, and the value is the first column in the listbox row.
Opening a form filtered by a string column
Some of the personnel have the same title, so the CommandTitlePersonnel button uses the value of the Title in the third column to open the form filtered
Private Sub CommandTitlePersonnel_Click() On Error GoTo CommandTitlePersonnel_Click_Err If (ListPersonnel.ListIndex > -1) Then DoCmd.OpenForm "Personnel", acNormal, "", "[Title]= '" & _ [ListPersonnel].Column(2) & "'", , acNormal Else Beep MsgBox "Please select a person first", vbOKOnly, "Edit Personnel ?" End If CommandTitlePersonnel_Click_Exit: Exit Sub CommandTitlePersonnel_Click_Err: MsgBox Error$ Resume CommandTitlePersonnel_Click_Exit End Sub
Opening a form filtered by a date column
Dates are interesting because of the potential of misunderstanding months and days because the order is different in the US and most other countries, and because the values are actually stored with hours, minutes and seconds. So, my solution is to use a date format that is unambiguous and to modify the clause to be between the start and end of the selected day.
Private Sub CommandStartDatePersonnel_Click() On Error GoTo CommandStartDatePersonnel_Click_Err If (ListPersonnel.ListIndex > -1) Then DoCmd.OpenForm "Personnel", acNormal, "", "[Start_Date] BETWEEN #" & _ Format([ListPersonnel].Column(4), "dd MMM YYYY") & " 00:00# AND #" & _ Format([ListPersonnel].Column(4), "dd MMM YYYY") & " 23:59#", , acNormal Else Beep MsgBox "Please select a person first", vbOKOnly, "Edit Personnel ?" End If CommandStartDatePersonnel_Click_Exit: Exit Sub CommandStartDatePersonnel_Click_Err: MsgBox Error$ Resume CommandStartDatePersonnel_Click_Exit End Sub
Opening a form filtered by a lookup column
Lookup columns can be a problem because the value you see is not the value that is stored. For example, I created the Personnel.Department column as a lookup to the Departments table. So, queryPersonnel displays a string value for Departments.Department, but the primary key column of Department. My solution was to alias Personnel.Department AS DepartmentID, as shown in the SQL for queryPersonnel below. This provides an editable column for any form based on the query. I did similar for Master_Shape and Reports_To :
SELECT Personnel.ID, Personnel.Name, Personnel.Title, Personnel_1.Name AS Reports_To, Departments.Department, Personnel.Telephone, Personnel.[E-mail] AS [E-Mail], Personnel.Office_Number, Master_Shapes.Master_Shape, "CallTo:"+[Personnel].[Telephone] AS CallTo, "MailTo:"+[Personnel].[E-mail] AS MailTo, Personnel.Start_Date, Personnel.Gender, Personnel.HasDrivingLicence, Personnel.Birth_Date, Master_Shapes.Min_Cost, Master_Shapes.Max_Cost, Departments.Red, Departments.Green, Departments.Blue, Personnel.Department AS DepartmentID, Personnel.Master_Shape AS Master_ShapeID, Personnel.Reports_To AS Reports_ToID FROM ((Personnel LEFT JOIN Departments ON Personnel.[Department] = Departments.ID) LEFT JOIN Master_Shapes ON Personnel.[Master_Shape] = Master_Shapes.ID) LEFT JOIN Personnel AS Personnel_1 ON Personnel.[Reports_To] = Personnel_1.ID;
This meant that I could write the function for CommandDepartmentPersonnel that uses the string value in the fourth column of the listbox.
Private Sub CommandDepartmentPersonnel_Click() On Error GoTo CommandDepartmentPersonnel_Click_Err If (ListPersonnel.ListIndex > -1) Then DoCmd.OpenForm "Personnel", acNormal, "", "[Department]= '" & _ [ListPersonnel].Column(3) & "'", , acNormal Else Beep MsgBox "Please select a person first", vbOKOnly, "Edit Personnel ?" End If CommandDepartmentPersonnel_Click_Exit: Exit Sub CommandDepartmentPersonnel_Click_Err: MsgBox Error$ Resume CommandDepartmentPersonnel_Click_Exit End Sub
The Visio shapes
I used Data / Custom Import in Visio Professional 2016 to import the queryPersonnel query from the Access database to my Visio document. I then drew a simple rectangle in Visio, and linked it to one of the rows in the External Data window. Thus automatically created Shape Rows to the rectangle. I then used Data Graphics to display the Name and Title as Text callouts, Department as Color by Value, and Gender as in Icon Set. All this is purely optional, as only Shape Data rows with the values to use as a filter are necessary for this solution. I then opened the ShapeSheet and added four right-mouse menu actions to the shape that called a VBA sub-function, OpenInAccess , in the Visio document.
The ShapeSheet function CALLTHIS(…) can include optional arguments. I have added three arguments so that the form name, the filter column name in the form, and the Shape Data row that contains the value to filter with, can be passed through. Therefore the Actions row formulas, that are equivalent to the four Access buttons described earlier are:
=CALLTHIS("OpenInAccess","","Personnel","ID","_VisDM_ID") =CALLTHIS("OpenInAccess","","Personnel","Title","_VisDM_Title") =CALLTHIS("OpenInAccess","","Personnel","Start_Date","_VisDM_Start_Date") =CALLTHIS("OpenInAccess","","Personnel","Department","_VisDM_Department")
In this example I call VBA code that is directly in the Visio drawing document, but I would recommend that the VBA code is actually placed in a macro-enabled stencil so that it can be re-used in other documents.
The VBA code in Visio
In VBA, I first create a function, GetAccessApp(), to get hold of the Access application:
Private Function GetAccessApp() As Access.Application On Error GoTo errHandler Dim aApp As Access.Application Set aApp = GetObject(, "Access.Application") exitHere: Set GetAccessApp = aApp Exit Function errHandler: MsgBox Err.Description, vbExclamation, "GetAccessApp" Resume exitHere End Function
The next function, OpenAccessPerson(…), uses the Access application object to open the Access form with the specified criteria, just like the Access VBA code:
Private Sub OpenAccessPerson(ByVal formName As String, _ ByVal criteria As String) On Error GoTo errHandler Dim aApp As Access.Application Set aApp = GetAccessApp() If aApp Is Nothing Then Else aApp.DoCmd.OpenForm formName, acNormal, "", _ criteria, , acNormal End If exitHere: Set aApp = Nothing Exit Sub errHandler: MsgBox Err.Description, vbExclamation, "OpenAccessPerson" Resume exitHere End Sub
Finally, I created a sub-function that can be called by the CALLTHIS(…) ShapeSheet function with the arguments for the form name, form field and Shape Data row:
Public Sub OpenInAccess(ByVal shpIn As Visio.Shape, _ ByVal formName As String, ByVal keyCol As String, ByVal keyProp As String) Dim criteria As String criteria = "[" & keyCol & "] " If shpIn.CellExists("Prop." & keyProp, Visio.visExistsAnywhere) <> 0 Then Select Case shpIn.Cells("Prop." & keyProp & ".Type").ResultIU Case 2 'Numeric criteria = criteria & "= " * _ shpIn.Cells("Prop." & keyProp).ResultIU Case 5 'Date criteria = criteria & "BETWEEN #" & _ Format(shpIn.Cells("Prop." & keyProp).ResultStr(""), _ "dd/mmm/yyyy") & " 00:00# AND #" & _ Format(shpIn.Cells("Prop." & keyProp).ResultStr(""), _ "dd/mmm/yyyy") & " 23:59#" Case Else criteria = criteria & "= '" & _ shpIn.Cells("Prop." & keyProp).ResultStr("") & "'" End Select OpenAccessPerson formName, criteria End If End Sub
That’s it! The user can now open the named form in the running Access application with the filter defined.