Site icon bVisual

Opening an MS Access form from a Visio shape

David Parker

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:

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.

Exit mobile version