Archive for ‘MS Access VBA Programming’

April 8th, 2011

MS Access – VBA – Determine Where a Field Is Used

I recently had to make a minor change to a poorly designed, but large database and had to determine where certain fields were being used so I could go make the necessary changes. In this case, I had to review hundreds of MS Access objects, so a manual approach was just not acceptable. As such, I created a VBA to let the computer do the checking for me and report back. Below is the fruits of my labor.

'---------------------------------------------------------------------------------------
' Procedure : FindFieldUsedWhere
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Locate where a field is used within queries, forms and reports
' 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:
' ~~~~~~~~~~~~~~~~
' sFieldName    : Field Name to search for in the various Access objects
'
' Usage:
' ~~~~~~
' FindFieldUsedWhere("Type A")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2011-04-08                 Initial Release
'---------------------------------------------------------------------------------------
Function FindFieldUsedWhere(sFieldName As String)
On Error GoTo Error_Handler
    Dim db               As DAO.Database
    Dim qdf              As DAO.QueryDef
    Dim sSQL             As String
    Dim ctl              As Control
    Dim frm              As AccessObject
    Dim DbO              As AccessObject
    Dim DbP              As Object
 
    Set db = CurrentDb
    Debug.Print "FindFieldUsedWhere Begin"
    Debug.Print "Searching for '" & sFieldName & "'"
    Debug.Print "================================================================================"
 
    'Check Queries
    For Each qdf In db.QueryDefs
        'qdf.Name    'The current query's name
        'qdf.SQL     'The current query's SQL statement
        sSQL = qdf.SQL
        If InStr(sSQL, sFieldName) Then
            'The Query is a Make Table Query and has our TableName we are looking for
            Debug.Print "Query: " & qdf.Name
        End If
    Next
 
    'Check Forms
    For Each frm In CurrentProject.AllForms
        DoCmd.OpenForm frm.Name, acDesign
        If InStr(Forms(frm.Name).RecordSource, sFieldName) Then
            'The Query is a Make Table Query and has our TableName we are looking for
            Debug.Print "Form: " & frm.Name
        End If
        'Loop throught the Form Controls
        For Each ctl In Forms(frm.Name).Form.Controls
            Select Case ctl.ControlType
                Case acComboBox
                    If Len(ctl.Tag) > 0 Then
                        If InStr(ctl.Tag, sFieldName) Then
                            'The Query is a Make Table Query and has our TableName we are looking for
                            Debug.Print "Form: " & frm.Name & " :: Control: " & ctl.Name
                        End If
                        If InStr(ctl.ControlSource, sFieldName) Then
                            'The Query is a Make Table Query and has our TableName we are looking for
                            Debug.Print "Form: " & frm.Name & " :: Control: " & ctl.Name
                        End If
                    End If
                Case acTextBox, acCheckBox
                    If InStr(ctl.ControlSource, sFieldName) Then
                        'The Query is a Make Table Query and has our TableName we are looking for
                        Debug.Print "Form: " & frm.Name & " :: Control: " & ctl.Name
                    End If
            End Select
        Next ctl
        DoCmd.Close acForm, frm.Name, acSaveNo
    Next frm
 
    'Check Reports
    Set DbP = Application.CurrentProject
    For Each DbO In DbP.AllReports
        DoCmd.OpenReport DbO.Name, acDesign
        If InStr(Reports(DbO.Name).RecordSource, sFieldName) Then
            'The Query is a Make Table Query and has our TableName we are looking for
            Debug.Print "Report: " & DbO.Name
        End If
        'Loop throught the Report Controls
        For Each ctl In Reports(DbO.Name).Report.Controls
            Select Case ctl.ControlType
                Case acComboBox
                    If Len(ctl.Tag) > 0 Then
                        If InStr(ctl.Tag, sFieldName) Then
                            'The Query is a Make Table Query and has our TableName we are looking for
                            Debug.Print "Report: " & DbO.Name & " :: Control: " & ctl.Name
                        End If
                        If InStr(ctl.ControlSource, sFieldName) Then
                            'The Query is a Make Table Query and has our TableName we are looking for
                            Debug.Print "Report: " & DbO.Name & " :: Control: " & ctl.Name
                        End If
                    End If
                Case acTextBox, acCheckBox
                    If InStr(ctl.ControlSource, sFieldName) Then
                        'The Query is a Make Table Query and has our TableName we are looking for
                        Debug.Print "Report: " & DbO.Name & " :: Control: " & ctl.Name
                    End If
            End Select
        Next ctl
        DoCmd.Close acReport, DbO.Name, acSaveNo
    Next DbO
 
    Debug.Print "================================================================================"
    Debug.Print "FindFieldUsedWhere End"
 
Error_Handler_Exit:
    On Error Resume Next
    Set qdf = Nothing
    Set db = Nothing
    Set ctl = Nothing
    Set frm = Nothing
    Set DbP = Nothing
    Set DbO = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: FindFieldUsedWhere" & vbCrLf & _
           "Error Description: " & Err.Description, vbCritical, "An Error has Occured
    Resume Error_Handler_Exit
End Function

This is my first draft and I haven’t looked at optimizing my code. It was more about getting results than developing a procedure to be reused often. Hopefully it can help someone else in the same boat as I found myself! Simply execute the procedure and it will return a listing of what Access objects use the specified field in the immediate window of the VBE console.

April 7th, 2011

MS Access – VBA – Relink Back-End Tables

In any well developed MS Access database it becomes necessary to automate the relinking of the back-end database tables. There are any number of existing resources that you can very rapidly implement.

Below are a few useful link to get you going:

In complexe database setups, it may become necessary to relink your database to multiple back-ends. I started out writting my own code to do this and then came accross nice sample from David Fenton Associates:

Hopefully these links will save you some time searching the net.

March 13th, 2011

FMS Total Visual SourceBook Review

FMSTotal Visual SourceBook

What I wouldn’t have given to be aware of this add-in when I was starting out as a developer! Seriously, this add-in would have saved me hundreds, if not thousands, of hours searching online, posting to forums, to find out how to code what I needed to do. Beyond which, it provides the user with a standardized set of procedures, instead of trying to piece together countless routines found here and there as you search online.

Just yesterday, I needed a particular routine and instead of searching online, as I always have done until now, I opened the TVSB, performed a quick search, exported the appropriate code into my module and was back at work in a matter of 1-2 minutes, if that!

 

So what did I think of the TVSB?

Cons:

  • I wish it could be somehow directly integrated within the VBE as done with certain other add-ins rather than a separate popup application. Have some type of integrated toolbar with a drop down category/procedures/… select the procedure and BAM there is. AND, I’m not saying it is hard to export the procedures from the SourceBook the way it is currently setup. That said, even though it would be nice, I myself am not sure how it could be accomplished.
  • My other issue is that their code uses Early biding which I try to avoid normally as it can causes reference issues. So their code is a nice starting point, but I would convert most of the classes, procedures,… into late binding for my own purposes. Over the course of several years, I have learnt that Late Binding avoids reference issues and this outways (in my opinion) any performance benefits Early Binding presents. At the end of the day, each developer has their own opinion and experience with regards to this aspect of programming, so feel free to make up your mind on this aspect yourself. To learn a little bit more about the pros and cons of Early Binding vs. Late Binding take a look at Early vs. Late Binding
    from the Word MVP site, it is a short overview of the issue.

 

Pros:

  • Easy to install
  • Can be integrated to work in a team environment (untested)
  • Easy to navigate and work with
  • It is very intuitive
  • Came with a user manual! Just this to me put this application above most others!!! Although, in this case, a manual is not necessary.
  • The code itself, is well categorized so you can find things quite easily just by noising around.
  • Effective search tool enable one to quickly search through the repository.
  • Extendable. You can add your own code (procedures, modules, …) to the repository so you can build upon what is already there.
  • Good export utility (export directly into your module, to a file, …)
  • Customizable – You can configure the Error Handler and other elements to suit your programming methodologies.

Put simply, the FMS Total Visual SourceBook (TVSB) is a simple to use, powerful work tool that can easily accelerate the development process of any developer and give you a leg up on your competition.

March 9th, 2011

MS Access – Report – Change a Report’s RecordSource

The following procedure can be used to change the RecordSource of a Report.

'---------------------------------------------------------------------------------------
' Procedure : RedefRptSQL
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Redefine an existing report's recordsource
'             Requires opening the form in design mode to make the changes
' 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 Query to redefine the SQL statement of
' sSQL        ~ SQL Statement to be used to refine the query with
'
' Usage:
' ~~~~~~
' RedefRptSQL "Report1", "SELECT * FROM tbl_Contacts ORDER BY LastName;"
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2009-07-13                 Initial Release
'---------------------------------------------------------------------------------------
Function RedefRptSQL(sRptName As String, sSQL As String)
On Error GoTo Error_Handler
    Dim Rpt     As Report
 
    DoCmd.OpenReport sRptName, acViewDesign, , , acHidden 'Open in design view so we can
                                                          'make our changes
    Set Rpt = Application.Reports(sRptName)
    Rpt.RecordSource = sSQL                               'Change the RecordSource
    DoCmd.Close acReport, sRptName, acSaveYes             'Save our changes

Error_Handler_Exit:
    On Error Resume Next
    Set Rpt = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
            "     Error Number: " & Err.Number & vbCrLf & _
            "     Error Source: RedefRptSQL" & vbCrLf & _
            "     Error Description: " & Err.Description, _
            vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

February 15th, 2011

MS Access – VBA – Minimize/Maximize Access Application

Here is another common question, how can I control the Application window itself? Well that depends on what exactly you wish to do. So things are easy to do and other require APIs, etc.

 

Minimize/Maximize and Restore the MS Access Application Window

One can very easily control the Application Window state with one simple command, the often overlooked DoCmd.RunCommand!

DoCmd.RunCommand acCmdAppMinimize 'Minimize the MS Access Application
DoCmd.RunCommand acCmdAppMaximize 'Maximize the MS Access Application
DoCmd.RunCommand acCmdAppRestore 'Restore the MS Access Application

 

Completely Hide the MS Access Application Window

Once again, a not so uncommon question. Now implementing it requires a little more programming than merely minimizing or maximizing the application window, but it can be done! Now if you Google the subject you will find any number of code samples. That said, before I ‘waste‘ my time searching for anything relating to MS Access I always go and check The Access Web where you will find a ready to use API entitled Manipulate Access Window to do exactly this.

January 17th, 2011

MS Access – VBA – The Save Operation Failed

I was recently working on a database of mine which has been in production for over 4 years now and all of a sudden it started giving me the error: “The Save Operation Failed”. Nothing like a nice obscur error message from the VBA/VBE!!!

I tried the normal approaches: Compact and repair, Decompile/Recompile, … None worked for me.

I took a look at Microsoft’s Knowledge Base and found an article, ACC97: Error “The Save operation failed” When Saving a Module, for Access 97 (as a lot of the information can be used in furture version, I read it over). Sadly, the article is pretty much useless.

In the end, the solution, for me, was to start a new database and import all of the database objects (File -> Get External Data -> Import) from the database giving me the error message. Setup the startup properties… and everything was in working order again!

I hope this helps someone else in the same perdicament!

January 6th, 2011

MS Access – VBE – Plug-Ins, Add-Ons, Etc

One thing any good worker will tell you is that you must have the right tools to do the job. Computer programming, MS Access database development, is no exception to this rule! I thought I’d list a few add-ins, plug-ins, etc. that I have come across, or heard of. This is an unbiased listing and I have no link to any of the vendors, nor have I even used all of them. I am simply trying to regroup them to help you find them, and you can judge their usefullness on your own. In a future post, I will examine the 2 or 3 that I use myself and find very useful.

Free Ones
MZ-Tools
Smart Indenter
V-Tools

Ones you have to pay for
Find and Replace (30 day evaluation then you have to register/pay)
FMS Inc. Tools — FMS offers a multitude of various tools worth reviewing, including: Total Visual Source Book and Total Access Admin

 

A Few More Untested Add-ins (Update 2011-Mar-09)

Various utilies by Bill Mosca (Access MVP)
ACCESS Dependency Checker
http://www.4tops.com/query_tree.htm
http://www.4tops.com/ms_access_vba.htm
Compare Em – Compare 2 database to identify the differences and generate the necessary code to make the updates.

December 9th, 2010

MS Access – VBA – Determine if a Module Exists

Sometimes it can be handy to be able to identify whether or not a module is in a database or not. One way to check is to loop through the AllModules collection to see if it is there or not. Below is a sample procedure that demonstrates how you can check for the existance of a VBA module within your database.

 

Determine whether a Module Exists using the AllModules Collection

'---------------------------------------------------------------------------------------
' Procedure : ModuleExist
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Determine if a module exists within the 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:
' ~~~~~~~~~~~~~~~~
' sModuleName - Name of the module you are searching for
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' ModuleExist("Module2")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2008-Aug-13                 Initial Release
'---------------------------------------------------------------------------------------
Function ModuleExist(sModuleName As String) As Boolean
On Error GoTo Error_Handler
Dim mdl                   As Object
    ModuleExist = False 'Initialize our variable
    'Loop trhough all the modules in the database
    For Each mdl In CurrentProject.AllModules
        If mdl.Name = sModuleName Then
            ModuleExist = True
            Exit For 'No point continuing if found
        End If
    Next
 
Error_Handler_Exit:
    On Error Resume Next
    Set mdl = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: ModuleExist" & vbCrLf & _
           "Error Description: " & Err.Description, _
           vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

December 6th, 2010

VBA – Validate Email Address

One option is to systematically check for the various dos and don’t using a series of if statements such as that in the function below:

Public Function isValidEmail(inEmailAddress As String) As Boolean 
' Author: Unknown

If (Len(inEmailAddress) = 0) Then 
    MsgBox "Please enter your email address." 
    isValidEmail = False 
    Exit Function 
End If 
If (InStr(1, inEmailAddress, "@") = 0) Then 
    MsgBox "The '@' is missing from your e-mail address." 
    isValidEmail = False 
    Exit Function 
End If 
If (InStr(1, inEmailAddress, ".") = 0) Then 
    MsgBox "The '.' is missing from your e-mail address." 
    isValidEmail = False 
    Exit Function 
End If 
 
If (InStr(inEmailAddress, "@.") > 0) Then 
    MsgBox "There is nothing between '@' and '.'" 
    isValidEmail = False 
    Exit Function 
End If 
 
If ((InStr(inEmailAddress, ".")) = ((Len(inEmailAddress)))) Then 
    MsgBox "There has to be something after the '.'" 
    isValidEmail = False 
    Exit Function 
End If 
 
If ((Len(inEmailAddress)) < (InStr(inEmailAddress, ".") + 2)) Then 
    MsgBox "There should be two letters after the '.'" 
    isValidEmail = False 
    Exit Function 
End If 
 
If (InStr(1, inEmailAddress, "@") = 1) Then 
    MsgBox "You have to have something before the '@'" 
    isValidEmail = False 
    Exit Function 
End If 
 
isValidEmail = True 
End Function

A Second better approach, like with many web programming languages, is to use regular expressions to validate certain type of strings. Now Access’ VBA does not allow RegEx persey, but you can very easily access such functionality by adding 2 simple lines of code. You then end up with a total of a three lines of code to validate almost any string, including an e-mail address. For all the details, and a link to where you can get a multitude of the RegEx so you don’t have to reinvent the wheel simply check out my post VBA – Using Regular Expressions (RegEx)

December 5th, 2010

MS Access – VBA – Loop Through All The Controls on a Form

Below is come sample VBA which illustrates how one can easily loop through all the controls within a form to identify and work with them.

Dim ctl As Control
For Each ctl In Me.Controls
    ctl.Name 'Get the name of the control
    ctl.Value 'Get or set the value of the control
    ctl.Visible = False 'Control the visibility of the control
Next ctl

Now how can this be put to good use? Well one use for such code would be to setup a Select All, or Select None button for a series of check boxes on a form. Below is what the code could look like for each command button:

'Select All
Dim ctl As Control
For Each ctl In Me.Controls
    If ctl.ControlType = acCheckBox Then
        If ctl.Value <> True Then
            ctl.Value = True
        End If
    End If
Next ctl
 
'Select None
Dim ctl As Control
For Each ctl In Me.Controls
    If ctl.ControlType = acCheckBox Then
        If ctl.Value <> False Then
            ctl.Value = False
        End If
    End If
Next ctl

Lastly, you could easily adapt the general form specific code and transform it into a generic procedure to which you will supply the form name to loop through the control, rather than working with the current form, you could do something along the lines of:

Function YourProcedureName(ControlName As String, frm As Access.Form)
    Dim ctl As Access.Control
    For Each ctl In frm.Controls
 
 
    Next ctl
End Function

November 15th, 2010

MS Access – VBA – Move A Folder

If you have ever tried to use the File Scripting Object to perform a FolderMove, you’ve quickly learnt that it spits out a Permission Denied error when you try to move a folder to another drive or try to move a folder which is not on the same drive as the move.exe. So how can you get around this problem, well actually, it is quite easy. The function below will perform the move for you. Instead of simply moving the directory, we actually copy it and then delete the source directory. Easy as pie! Enjoy

'---------------------------------------------------------------------------------------
' Procedure : MoveFolder
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Move a folder
'             Better version of the FSO's MoveFolder method which is basically a "rename"
'             method, hence it only works if the source and destination reside on
'             the same volume (same as move.exe under WinXP) and typically returns
'             a permission denied error.
' 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:
' ~~~~~~~~~~~~~~~~
' sFolderSource         Folder to move
' sFolderDestination    Folder to move the folder to
' bOverWriteFiles       Whether to overwrite file(s) if the folder already exists
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' MoveFolder("C:\Temp", "D:\Development\New")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2010-Nov-14                 Initial Release
'---------------------------------------------------------------------------------------
Function MoveFolder(sFolderSource As String, sFolderDestination As String, _
                    bOverWriteFiles As Boolean) As Boolean
On Error GoTo Error_Handler
    Dim fs As Object
 
    MoveFolder = False
    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.CopyFolder sFolderSource, sFolderDestination, bOverWriteFiles
    fs.DeleteFolder sFolderSource, True
    MoveFolder = True
 
Error_Handler_Exit:
    On Error Resume Next
    Set fs = Nothing
    Exit Function
 
Error_Handler:
    If Err.Number = 76 Then
        MsgBox "The 'Source Folder' could not be found to make a copy of.", _
                vbCritical, "Unable to Find the Specified Folder"
    Else
        MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: MoveFolder" & vbCrLf & _
               "Error Description: " & Err.Description, _
               vbCritical, "An Error has Occured!"
    End If
    Resume Error_Handler_Exit
End Function

November 14th, 2010

MS Access – VBA – Copy A Folder

Below is a simple little function which will allow you to make a copy of a folder since it uses the File Scripting Object it can be used in all VBA Applications (Word, Excel, Access, PowerPoint, …).

'---------------------------------------------------------------------------------------
' Procedure : CopyFolder
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Copy a folder
' 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:
' ~~~~~~~~~~~~~~~~
' sFolderSource         Folder to be copied
' sFolderDestination    Folder to copy to
' bOverWriteFiles       Whether to overwrite file(s) if the folder already exists
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' CopyFolder("C:\Temp", "D:\Development\New", True)
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2010-Nov-14                 Initial Release
'---------------------------------------------------------------------------------------
Function CopyFolder(sFolderSource As String, sFolderDestination As String, _
                    bOverWriteFiles As Boolean) As Boolean
On Error GoTo Error_Handler
    Dim fs As Object
 
    CopyFolder = False
    Set fs = CreateObject("Scripting.FileSystemObject")
    fs.CopyFolder sFolderSource, sFolderDestination, bOverWriteFiles
    CopyFolder = True
 
Error_Handler_Exit:
    On Error Resume Next
    Set fs = Nothing
    Exit Function
 
Error_Handler:
    If Err.Number = 76 Then
        MsgBox "The 'Source Folder' could not be found to make a copy of.", _
                vbCritical, "Unable to Find the Specified Folder"
    Else
        MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
               "Error Number: " & Err.Number & vbCrLf & _
               "Error Source: CopyFolder" & vbCrLf & _
               "Error Description: " & Err.Description, _
               vbCritical, "An Error has Occured!"
    End If
    Resume Error_Handler_Exit
End Function

November 8th, 2010

MS Access – VBA – Run a Query in Another Database

So how can you run a query in another database?

Well, that depends! It depends on whether you simply need to run an action query or if you actually wish to get the results returned to you.

One method is to use DAO programming to access the remote db and simply execute the query. This implies that you are simply wanting to run an action query.

Dim db As DAO.Database
Set db = DBEngine.Workspaces(0).OpenDatabase("FullPathAndFileNameOfThe2ndDb")
db.Execute "TheQueryNameYouWishToExecute", dbFailOnError
Set db = Nothing

Another method which will actually return the results of a SELECT query… is to add the 2nd database as a reference in your 1st database and then call a function which open you query. You can find a sample database illustrating this technique at http://www.access-programmers.co.uk/forums/showthread.php?t=156716 (in the second post by MStef).

November 1st, 2010

MS Access – Determine if Runtime or Full Version

As you start to do more and more advanced vba development you may have the need to determine whether your user is using the full blown version of MS Access or the runtime version. Some code/procedures will throw errors in the runtime, that normally would not in the full blown version of MS Access. So how can you determine this? Well, it is surprisingly simple! A simple IF statement can determine this for you, as shown below.

    If SysCmd(acSysCmdRuntime) = False Then
        'The user is using a full blown version of MS Access
        
    Else
        'The user is using the runtime version of MS Access

    End If

October 30th, 2010

MS Access – Auto Increment a Value

Have you ever needed to auto increment a revision number (ie:AZ -> BA or A1 -> A2)?

I can’t take credit for the following function, but knew it could help a lot of people. It works for AlphaNumeric value so it is very versatile compared to standard alpha incrementors. Once again, many thanks to both Graham Seach and Stefan Hoffman for sharing with us all!

Public Function IncrementAlphaNumCode(strCode As String) As String
'Author: Graham R Seach Microsoft Access MVP Sydney, Australia
'Source: http://social.answers.microsoft.com/Forums/en-US/addbuz/thread/6cc09fc4-4a58-4e5c-aa7d-d1cc36a5483c
'Based on code developed by Stefan Hoffman MVP
Dim lngASCII As Long
Dim lngCount As Long
Dim lngLength As Long
Dim strResult As String
Dim lngValues() As Long
Const BASE_DECIMAL As Long = 10
Const BASE_HEXAVIGESIMAL As Long = 26
Const BASE As Long = 0
Const VALUE As Long = 1
 
strCode = Trim(UCase(strCode))
lngLength = Len(strCode)
 
ReDim lngValues(lngLength, 1)
lngValues(lngLength, BASE) = BASE_DECIMAL
lngValues(lngLength, VALUE) = 0
 
'Decode to plain decimal
For lngCount = 0 To lngLength - 1
    lngASCII = Asc(Mid(strCode, lngLength - lngCount, 1))
    Select Case lngASCII
        Case 48 To 57 'Numeric digit, base 10, decimal
            lngValues(lngCount, BASE) = BASE_DECIMAL
            lngValues(lngCount, VALUE) = lngASCII - 48
        Case 65 To 90 'Alphabetical character, base 26, hexavigesimal (upper case)
            lngValues(lngCount, BASE) = BASE_HEXAVIGESIMAL
            lngValues(lngCount, VALUE) = lngASCII - 65
        Case Else 'Non-alphanumeric character
            Err.Raise vbObjectError + 512, "IncrementCode", "Invalid character in source string"
    End Select
Next lngCount    'Increment

lngValues(0, VALUE) = lngValues(0, VALUE) + 1    'Calculate the carry forward
For lngCount = 0 To lngLength - 1
    If lngValues(lngCount, VALUE) >= lngValues(lngCount, BASE) Then
        lngValues(lngCount, VALUE) = 0
        lngValues(lngCount + 1, VALUE) = lngValues(lngCount + 1, VALUE) + 1
    End If
Next lngCount
 
'Encode back to mixed decimal/hexavigesimal
strResult = ""
For lngCount = 0 To lngLength
    If lngCount = lngLength And lngValues(lngCount, VALUE) = 0 Then
        Exit For
    End If
    If lngValues(lngCount, BASE) = BASE_DECIMAL Then
        strResult = Chr(lngValues(lngCount, VALUE) + 48) & strResult
    Else
        strResult = Chr(lngValues(lngCount, VALUE) + 65) & strResult
    End If
Next lngCount
 
IncrementAlphaNumCode = strResult
End Function

October 22nd, 2010

MS Access – VBA – Number of Weekdays Between Two Dates

Have you ever needed to calculate the number of weekdays (Monday through Friday) there were between two dates, that is exactly what the VBA function below does.

'---------------------------------------------------------------------------------------
' Procedure : CalcNoWeekDays
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Count the number of weekdays between two specified dates
' 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:
' ~~~~~~~~~~~~~~~~
' dtFirstDate   The first of 2 dates to count the number of weekdays between
' dtLastDate    The second of 2 dates to count the number of weekdays between
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' CalcNoWeekDays(#2010-10-6#,#2010-10-23#)      =23
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2010-Jul-09                 Initial Release
'---------------------------------------------------------------------------------------
Function CalcNoWeekDays(dtFirstDate As Date, dtLastDate As Date) As Integer
On Error GoTo Error_Handler
    Dim dtDay   As Date
 
    'Ensure that the dates provided are in the proper order
    If dtFirstDate > dtLastDate Then
        dtDate1 = dtLastDate
        dtDate2 = dtFirstDate
    Else
        dtDate1 = dtFirstDate
        dtDate2 = dtLastDate
    End If
 
    CalcNoWeekDays = 0 'Initialize our weekday counter variable
    
    For dtDay = dtFirstDate To dtLastDate
        iDayOfWeek = Weekday(dtDay)
        If iDayOfWeek <> vbSunday And iDayOfWeek <> vbSaturday Then
            CalcNoWeekDays = CalcNoWeekDays + 1
        End If
    Next dtDay
 
Error_Handler_Exit:
    On Error Resume Next
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: CalcNoWeekDays" & vbCrLf & _
           "Error Description: " & Err.Description, vbCritical, _
           "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

October 19th, 2010

MS Access – VBA – Disable Query Warning Messages

Once you start doing some VBA programming in your database you will at some point or another want to run/execute queries through VBA. However, you may not want your user’s to receive the action query confirmation prompts, such as:

MS Access Action Query Confirmation Prompt Message

MS Access Action Query Confirmation Prompt Message

Nothing could be easier. To disable all confirmation prompts simply use the following line of code

DoCmd.SetWarnings False 'Turn off warnings

Of course do not forget to turn them back on after running your code so that legitimate messages are displayed.

DoCmd.SetWarnings True  'Turn warnings back on

October 12th, 2010

MS Access – Trig Functions

Have you ever needed to use trig functions in your database?

You may have noticed that although MS Access does offer basic trig functions:

  • Sin
  • Cos
  • Tan
  • Arctangent (atn)

it does not offer any of the advance, ‘Derived Math Functions’, such as:

  • Secant
  • Cosecant
  • Cotangent
  • Inverse Sine
  • Hyperbolic Sine
  • Inverse Hyperbolic Sine

As a developer you have one of two options:

  • Create, or find, a function to replicate these functions
  • Utilize Excel’s trig functions from within you database

 

Create, or find, a function to replicate these functions

If you simply lookup the term ‘Derived Math Functions’ in the VBE’s help file you will find all the necessary information to build your own custom functions. That said, why not simply benefit from the fact that others before you have already done this work for you and simply perform a quick Google search to locate and existing module with these functions. For instance:

 

Utilize Excel’s trig functions from within you database

If you know that the database will be utilized on a computer that also has Excel installed on it, why not simply use it’s powerful library of trig function! Nothing could be easier to do. Simply use a procedure such as the one presented below

'---------------------------------------------------------------------------------------
' Procedure : Atanh
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Calculate the Inverse Hyperbolic Tangent by using Excel's built-in
'             function
' 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:
' ~~~~~~~~~~~~~~~~
' x                 Value in Rads
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' Atanh(-0.9)       Gives -1.4722...
' Atanh(0)          Gives 0
'---------------------------------------------------------------------------------------
Function Atanh(x As Double) As Double
'This procedure requires a reference be set to the Microsoft Excel xx.x Library
On Error GoTo Error_Handler
    Dim oXls    As Excel.Application
 
    Set oXls = New Excel.Application
    Atanh = oXls.WorksheetFunction.Atanh(x)
 
Error_Handler_Exit:
    On Error Resume Next
    oXls.Quit
    Set oXls = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: YourModuleName/ListDbTables" & vbCrLf & _
           "Error Description: " & Err.Description, vbCritical, _
           "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

October 7th, 2010

MS Access – VBA – Error Handling

Before delving into actual programming functions and sub-routine, we must first establish an error handler. An error handler is a bit of code which will do pre-defined actions whenever an error occurs. For instance, generate a message to the user or developper describing the nature of the error. For an error handler to be useful, it must provide a minimum of information in its message to the user. Below is a typical example of an error handler I use. Modify it in any way to suit your exact needs.

On Error GoTo Error_Handler
    'Your code will go here
    
Error_Handler_Exit:
    On Error Resume Next
    Exit {PROCEDURE_TYPE}
 
Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: {PROCEDURE_NAME}/{MODULE_NAME}" & vbCrLf & _
           "Error Description: " & Err.Description, vbCritical, _
           "An Error has Occured!"
    Resume Error_Handler_Exit

A Concrete Example

Sub HelloWorld()
On Error GoTo Error_Handler
 
    MsgBox "Hello Word!"
 
Error_Handler_Exit:
    On Error Resume Next
    Exit Sub
 
Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: YourModuleName/HelloWorld" & vbCrLf & _
           "Error Description: " & Err.Description, vbCritical, _
           "An Error has Occured!"
    Resume Error_Handler_Exit
End Sub

Note: Although VBA provides programmers with the possibility of using the err.source statement, it sadly does not help truly identify the culprit of the current error. This is why you must manually enter in the {MODULE_NAME} / {PROCEDURE_NAME} for each error handler. Trust me, although it may take a few extra seconds to do, it will same you loads of troubleshooting time later on (I’m talking from experience)!!!

Also, if you are going to be doing some serious vba (MS Access, Word, Excel, …) work and not just a little tinkering, you should most probably seriously consider looking into the Mz-Tools add-in (free with no strings attached) in conjunction with implementing Allen Browne Error Log (for database developers). These two tools/approaches will greatly simplify and standardize your work!!!

September 29th, 2010

MS Access – VBA – Copy a File

Have you ever needed to make a copy of a file? Well, there are a number of ways that you can do it. For instance, one could create a FileScripting instance, but I find that using the FileCopy function to be the simplest and cleaness method. I created a very simply procedure around it to trap certain common errors.

'---------------------------------------------------------------------------------------
' Procedure : CopyFile
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Copy a file
'             Overwrites existing copy without prompting
'             Cannot copy locked files (currently in use)
' 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:
' ~~~~~~~~~~~~~~~~
' strSource - Path/Name of the file to be copied
' strDest - Path/Name for copying the file to
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' 1         2007-Apr-01             Initial Release
'---------------------------------------------------------------------------------------
Function CopyFile(strSource As String, strDest As String) As Boolean
On Error GoTo CopyFile_Error
 
    FileCopy strSource, strDest
    CopyFile = True
    Exit Function
 
CopyFile_Error:
    If Err.Number = 0 Then
    ElseIf Err.Number = 70 Then
        MsgBox "The file is currently in use and therfore is locked and cannot be copied at this" & _
               " time.  Please ensure that no one is using the file and try again.", vbOKOnly, _
               "File Currently in Use"
    ElseIf Err.Number = 53 Then
        MsgBox "The Source File '" & strSource & "' could not be found.  Please validate the" & _
               " location and name of the specifed Source File and try again", vbOKOnly, _
               "File Currently in Use"
    Else
        MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
               Err.Number & vbCrLf & "Error Source: ModExtFiles / CopyFile" & vbCrLf & _
               "Error Description: " & Err.Description, vbCritical, "An Error has Occured!"
    End If
    Exit Function
End Function

All you have to do is copy it into a module and then call it as required. Enjoy!

September 27th, 2010

MS Access – VBA – Rename a File

Ever simply needed to rename a file? Well, once again there are a multitude of ways to accomplish this within MS Access. I have seen numerous postings suggest using a scripting object and then copy the file while renaming the copied version. To me, if all you need is to rename the file, this is a uselessly complicated method. Instead why not simply use the Name function? It can all be accomplished in one clean line of code!!!

Name "C:\OldFileName" AS "C:\NewFileName"

Actually, you can even use the Name command to move and rename a file simultaneously.

Name "C:\OldDir\OldFileName" AS "C:\NewDir\NewFileName"

As you can see this is another versatile command to be aware of.

September 22nd, 2010

VBA – Run/Execute A File

Ever needed to run, execute a file? It could be a *.bat, *.vbs, *.exe, … One common method is to use the shell function. However, we see quite often in the forums and newsgroups regarding issues with it not working and users not getting the synthax right because of spaces in the file paths, etc.

Below is, yet again, a very simple procedure which encapsulates the file to be run/executed with the necessary quotations so that you no longer have any headaches trying to get your Shell function operational. Simply copy the function to a module and call it as indicated below.

'---------------------------------------------------------------------------------------
' Procedure : RunFile
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Run/Execute files from vba (bat, vbs,…)
' 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:
' ~~~~~~~~~~~~~~~~
' strFile - full path including filename and extension
' strWndStyle - style of the window in which the program is to be run
'               value can be vbHide,vbNormalFocus,vbMinimizedFocus
'               vbMaximizedFocus,vbNormalNoFocus or vbMinimizedNoFocus
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' RunFile("c:\test.bat", vbNormalFocus)
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2010-Feb-05             Initial Release
'---------------------------------------------------------------------------------------
Function RunFile(strFile As String, strWndStyle As String)
On Error GoTo Error_Handler
 
   Shell "cmd /k """ & strFile & """", strWndStyle
 
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: RunFile" & vbCrLf & "Error Description: " & _
   Err.Description, vbCritical, "An Error has Occured!"
   Resume Error_Handler_Exit
End Function

If however you are interested in opening a file, any type of file, then please refer to my MS Access VBA – Open a File post.

September 21st, 2010

MS Access – VBA – Automatically Adjust User Input to Percentage Values

Have you ever created a control on a form to enter percentage values and had your users complain because they enter whole numbers which get automatically multiplied by 100. So if the user enters 3, it will actually give 300%.

No worries anymore! I created a very simple procedure which will automatically readjust values entered by your users. 3 will automatically be updated to 0.03, which give 3%.

'---------------------------------------------------------------------------------------
' Procedure : ajustPercentage
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Automatically adjust whole number to percentage values
' 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).
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2010-Sep-21                 Initial Release
'---------------------------------------------------------------------------------------
Function ajustPercentage(sValue As Variant) As Double
On Error GoTo Error_Handler
 
    If IsNumeric(sValue) = True Then            'Only treat numeric values
        If Right(sValue, 1) = "%" Then
            sValue = Left(sValue, Len(sValue) - 1)
            ajustPercentage = CDbl(sValue)
        End If
 
        If sValue > 1 Then
            sValue = sValue / 100
            ajustPercentage = sValue
        Else
            ajustPercentage = sValue
        End If
    Else                                        'Data passed is not of numeric type
        ajustPercentage = 0
    End If
 
Error_Handler_Exit:
    On Error Resume Next
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: ajustPercentage" & vbCrLf & _
           "Error Description: " & Err.Description, vbCritical, _
           "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

The one thing to note regarding this procedure is that it is meant for controls/fields that you always expect a percentage value between 0% and 100%. If you expect percentage above 100% this procedure will not help you in that case and you will need to build a custom procedure for that situation.

September 19th, 2010

MS Access – VBA – Import Directory Listing Into A Table

I was asked in a forum how one could automate importing the links (path & Filename) of all the files contained within a specified directory. It is relatively easy to accomplish and the procedure below is one possible method.

The procedure has 2 input variables: strPath which is the full path of the directory whose files you wish to import all the file paths from adn strFilter which is an optional input variable should you wish to refine what type of document is imported (for instance is you only want to import PDFs then you’d enter “pdf”, Word documents “doc”, and so on).

Function ImportDirListing(strPath As String, Optional strFilter As String)
' Author: CARDA Consultants Inc, 2007-01-19
' 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).
'
' strPath = full path include trailing  ie:"c:windows"
' strFilter = extension of files ie:"pdf".  if you want to return
'             a complete listing of all the files enter a value of
'             "*" as the strFilter
On Error GoTo Error_Handler
 
Dim MyFile  As String
Dim db      As Database
Dim sSQL    As String
 
Set db = CurrentDb()
 
'Add the trailing  if it was omitted
If Right(strPath, 1) <> "" Then strPath = strPath & ""
'Modify the strFilter to include all files if omitted in the function
'call
If strFilter = "" Then strFilter = "*"
 
'Loop through all the files in the directory by using Dir$ function
MyFile = Dir$(strPath & "*." & strFilter)
Do While MyFile <> ""
    'Debug.Print MyFile
    sSQL = "INSERT INTO [YourTableName] (YourTableFieldName) VALUES(""" & MyFile & """)"
    db.Execute sSQL, dbFailOnError
    'dbs.RecordsAffected 'could be used to validate that the
                                    'query actually worked
    MyFile = Dir$
Loop
 
Error_Handler_Exit:
    On Error Resume Next
    Set db = Nothing
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: ImportDirListing" & vbCrLf & _
           "Error Description: " & Err.Description, vbCritical, _
           "An Error has Occured!"
    Resume Error_Handler_Exit
End Function

As always, I hope this is useful to someone.

September 9th, 2010

MS Access – VBA – Calculate the Number of Years

The following function accepts two dates as input variables and will return the number of years between those two dates. If you are looking to get a greater level of precision (months, days) then take a look at my post entitled MS Access – Calculate the Age

'---------------------------------------------------------------------------------------
' Procedure : NoYrs
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Calculate the number of Years between two dates
' 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).
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2010-Sep-09                 Initial Release
'---------------------------------------------------------------------------------------
Function NoYrs(Date1 As Date, Date2 As Date) As Integer
On Error GoTo Error_Handler
    Dim Y       As Integer
    Dim Temp1   As Date
 
    Temp1 = DateSerial(Year(Date2), Month(Date1), Day(Date1))
    Y = Year(Date2) - Year(Date1) + (Temp1 > Date2)
    NoYrs = Y
 
Error_Handler_Exit:
    On Error Resume Next
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Source: NoYrs" & vbCrLf & _
            "Error Description: " & Err.Description, _
            vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function