MS Access VBA – Open a File

It can be very useful at times to store the paths of files within a database such as word document, excel spreadsheets, etc. Most often it is then necessary to provide the user a method of opening these files without needing to personally navigating to each file themselves. The following line of code will open the given file in the default application associated with it.

Application.FollowHyperlink Method

Application.FollowHyperlink "FullPath&FileName"

Example:

Application.FollowHyperlink "C:\Documents and Settings\All Users\Documents\My Pictures\Sample Pictures\Sunset.jpg"

You can use the Application.FollowHyperlink can also be used to open a folder (not just files)

This technique has always worked very well for me. That said, certain updates, have caused new security warning message to now appear rather than simply open the file. As such, you may wish to use Allen Browne’s GoHyperlink() function instead as it eliminates these messages and make for a more seamless approach.

Custom Procedure Method Employing the ShellExecute API

Another very good alternative is to use the ExecuteFile sub courtesy of Graham Seach (Access MVP). A nice feature is that not only can you open the file, but you can also choose to print the file and control the appearance of the windowstyle of the given application.

'Source: http://www.pacificdb.com.au/MVP/Code/ExeFile.htm
Public Const SW_HIDE = 0
Public Const SW_MINIMIZE = 6
Public Const SW_RESTORE = 9
Public Const SW_SHOW = 5
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMINNOACTIVE = 7
Public Const SW_SHOWNA = 8
Public Const SW_SHOWNOACTIVATE = 4
Public Const SW_SHOWNORMAL = 1

Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
    (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) As Long

Public Sub ExecuteFile(sFileName As String, sAction As String)
    Dim vReturn As Long
    'sAction can be either "Open" or "Print".
    
    If ShellExecute(Access.hWndAccessApp, sAction, sFileName, vbNullString, "", SW_SHOWNORMAL) < 33 Then
        DoCmd.Beep
        MsgBox "File not found."
    End If
End Sub

Example:
To open a file in the default associated program:

Call ExecuteFile("C:\Documents and Settings\All Users\Documents\My Pictures\Sample Pictures\Sunset.jpg", "Open")

To print a file:

Call ExecuteFile("C:\Documents and Settings\All Users\Documents\My Pictures\Sample Pictures\Sunset.jpg", "Print")

MS Access – Listing of Database Objects (Tables, Queries, Forms, Reports, …)

It can be useful to have a listing of all the objects in the database. For instance, a listing of all the table or queries… This can easily be achieved using a query which uses as its source a hidden system table named ‘MSysObjects’.

The basic query SQL statment is as follows:

SELECT MsysObjects.Name AS [List Of Tables]
FROM MsysObjects
WHERE (((MsysObjects.Name Not Like "~*") And (MsysObjects.Name Not Like "MSys*")) 
	AND (MsysObjects.Type=1))
ORDER BY MsysObjects.Name;

You need only change the value of the (MsysObjects.Type)=1 part of the query expression to change what listing is returned. Below are the various common values of interest that can be used to return the various objects available in Access:

Object Type	Value
Tables (Local)	1
Tables (Linked using ODBC)	4
Tables (Linked)	6
Queries	5
Forms	-32768
Reports	-32764
Macros	-32766
Modules	-32761

Continue reading →

MS Access VBA – List Of Security Groups a User Belongs To

The following function will return a listing of all of the Security Group the current user belongs to.

Function fncUserGroups() As String
On Error GoTo Error_Handler
' Created and provided by Dirk Goldgar (MS Access MVP)
' NOTE: Requires a reference to the DAO Object Library.
' PURPOSE: Returns a comma-separated list of the security groups of which
'          the current user is a member.

    Dim ws          As DAO.Workspace
    Dim grp         As DAO.Group
    Dim strGroups   As String

    Set ws = DBEngine.Workspaces(0)

    For Each grp In ws.Users(CurrentUser).Groups
        strGroups = strGroups & ", " & grp.Name
    Next grp

    fncUserGroups = Mid(strGroups, 3)

Error_Handler_Exit:
    On Error Resume Next
    Set ws = Nothing
    Exit Function

Error_Handler:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: fncUserGroups" & vbCrLf & "Error Description: " & _
    Err.Description, vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

MS Access VBA – Looping through records

One very frequent ‘action’ that programmers need to do is to loop through records. This could be a Table or Query … The basic concept is illustrated below using DAO. Although this can be done using ADO as well, I use DAO as it is native to Access and thus most efficient.

Sub LoopRecExample()
On Error GoTo Error_Handler
    Dim db              As DAO.Database
    Dim rs              As DAO.Recordset
    Dim iCount      As Integer
    
    Set db = CurrentDb()
    Set rs = db.OpenRecordset("TableName") 'open the recordset for use (table, Query, SQL Statement)
    
    With rs
        If .RecordCount <> 0 Then 'Ensure that there are actually records to work with
            'The next 2 line will determine the number of returned records
            rs.MoveLast 'This is required otherwise you may not get the right count
            iCount = rs.RecordCount 'Determine the number of returned records
            
            Do While Not .BOF
                'Do something with the recordset/Your Code Goes Here
                .MovePrevious
            Loop
        End If
    End With
    
    rs.Close 'Close the recordset

Error_Handler_Exit:
    On Error Resume Next
    'Cleanup after ourselves
    Set rs = Nothing
    Set db = Nothing
    Exit Sub

Error_Handler:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: LoopRecExample" & vbCrLf & "Error Description: " & _
    Err.Description, vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

MS Access VBA – SendObject to Multiple Recipients

A common question regarding the SendObject Method is how can I specify multiple recipients for the To, CC, BCC variables. It is actually very easy to do! It is the same as that when you create a message manually using you e-mail software (such as Outlook, Outlook Express, Thunderbird, etc.), you need only separate the each e-mail recipient by a semi-colon.

Example:

DoCmd.SendObject acSendNoObject,,,"recipient1@somewhere.com;recipient2@somewhere.com",,,"YourSubject","YourEmailMessage"

And this applies to any of the e-mail recipient lists (To, CC or BCC).

MS Access – Creating PDFs

Please note that although below I refer to MS Access, most of these programs work within any application since they install a virtual printer that can be used to print from any program (MS Office and beyond).

MS Access 2003 (or earlier)

I will review 2 techniques for producing PDFs of Access Reports

The first, and the one I am most familiar with, is to install a PDF virtual printer. There are numerous PDF creation software programs on the market and depending on your exact need some are more appropriate than others. This said, for general use, the following 3 programs work well and are free.

CuteWriter – Works well

pdfcreator – Works well

pdf995 – Works well but you get a popup every time you use it. You can buy and unlocked version for 10$ (without the popup).

PDFConverter – I was sadly disappointed with this application. For simple text documents it did its’ job, but getting into charts, certificates and more complex documents it failed miserably.

Nitro Reader – Simply astounding! A great, free tool. Reader and PDF Writer all in one. If you do not need the ability to automate your PDF application, this is a great choice! It offers a multitude of settings, security, … Truly a beautiful application.

Then you can simply print to the PDF printer to convert any document (Word, Excel, Access, etc.) into a PDF. To learn how-to control your printers from code take a look at VBA Change Printer code from Albert D. Kallal’s website (near the very top of the page).

As I mentioned before, the programs listed above are for basic use. If you need to implement security and/or modify PDFs then I would recommend you get a professional PDF software. There is no denying that Acrobat is very good at what it does.

The second method is to utilize Stephen Lebans Report to PDF. The benefit to this solution is that you do not need to install a printer driver. So you can easily distribute this solution without requiring the end-user to perform any installation which they may not have the rights to do in the first place. Furthermore, since Stephen has distributed it in an ‘open source’ format, one can easily customize it as required by their unique needs.

For more information, take a look at Creating PDF files from within Microsoft Access from Tony Toews’ website.

For Access 2007

Microsoft finally saw that there was a need for PDF generation and developed an add-in, “2007 Microsoft Office Add-in: Microsoft Save as PDF or XPS”, for the entire Office Suite. So you can now simply download it, install it and print to it like a normal printer. You can download the add-in at:

https://web.archive.org/web/20061022031619/http://www.microsoft.com/downloads/details.aspx?familyid=4D951911-3E7E-4AE6-B059-A2E79ED87041&displaylang=en

MS Access VBA – Check if a Report is Open

The following simple little procedure can be used to check if a given report is already open.

'---------------------------------------------------------------------------------------
' Procedure : IsRptOpen
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Determine whether a report is open or not
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sRptName  : Name of the report to check if it is open or not
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' IsRptOpen("Report1")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2010-May-26                 Initial Release
'---------------------------------------------------------------------------------------
Function IsRptOpen(sRptName As String) As Boolean
On Error GoTo Error_Handler
   
    If Application.CurrentProject.AllReports(sRptName).IsLoaded = True Then
        IsRptOpen = True
    Else
        IsRptOpen = False
    End If
   
Error_Handler_Exit:
    On Error Resume Next
    Exit Function

Error_Handler:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: IsRptOpen" & vbCrLf & "Error Description: " & _
    Err.Description, vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

MS Access VBA – Determine if a Report Exists

The following procedure can be used to determine if a specified report exists in the current database.

'---------------------------------------------------------------------------------------
' Procedure : DoesRptExist
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Determine if the specified report exists or not in the current database
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sReportName : Name of the report to check the existence of
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' DoesRptExist("Report1")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2010-Feb-02             Initial Release
'---------------------------------------------------------------------------------------
Function DoesRptExist(sReportName As String) As Boolean
   Dim rpt  As Object
  
On Error GoTo Error_Handler
   'Initialize our variable
   DoesRptExist = False
  
   Set rpt = CurrentProject.AllReports(sReportName)
  
   DoesRptExist = True  'If we made it to here without triggering an error
                        'the report exists

Error_Handler_Exit:
   On Error Resume Next
   Set rpt = Nothing
   Exit Function

Error_Handler:
   If Err.Number = 2467 Then
      'If we are here it is because the report could not be found
   Else
      MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
      Err.Number & vbCrLf & "Error Source: DoesRptExist" & vbCrLf & "Error Description: " & _
      Err.Description, vbCritical, "An Error has Occurred!"
   End If
   Resume Error_Handler_Exit
End Function

MS Access VBA – Count the Number of Open Reports

'---------------------------------------------------------------------------------------
' Procedure : CountOpenRpts
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Returns a count of the number of loaded reports (preview or design)
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites.
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2009-Oct-30                 Initial Release
' 2         2009-Oct-31                 Switched from AllReports to Reports collection
'---------------------------------------------------------------------------------------
Function CountOpenRpts()
On Error GoTo Error_Handler

    CountOpenRpts = Application.Reports.Count

Exit Function

Error_Handler:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: CountOpenRpts" & vbCrLf & "Error Description: " & _
    Err.Description, vbCritical, "An Error has Occurred!"
    Exit Function
End Function

MS Access VBA – List Currently Open Reports

'---------------------------------------------------------------------------------------
' Procedure : ListOpenRpts
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Returns a list of all the loaded reports (preview or design)
'             separated by ; (ie: Report1;Report2;Report3)
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites.
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2009-Oct-30                 Initial Release
' 2         2009-Oct-31                 Switched from AllReports to Reports collection
'---------------------------------------------------------------------------------------
Function ListOpenRpts()
On Error GoTo Error_Handler

    Dim DbR     As Report
    Dim DbO     As Object
    Dim Rpts    As Variant
   
    Set DbO = Application.Reports
   
    For Each DbR In DbO    'Loop all the reports
            Rpts = Rpts & ";" & DbR.Name
    Next DbR
   
    If Len(Rpts) > 0 Then
        Rpts = Right(Rpts, Len(Rpts) - 1)   'Truncate initial ;
    End If
   
    ListOpenRpts = Rpts

Exit Function

Error_Handler:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: ListOpenRpts" & vbCrLf & "Error Description: " & _
    Err.Description, vbCritical, "An Error has Occurred!"
    Exit Function
End Function