April 8th, 2011
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.
MS Access Forms, MS Access Queries, MS Access Reports, MS Access VBA Programming |
1 Comment »
April 7th, 2011
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.
MS Access, MS Access Tables, MS Access VBA Programming |
No Comments »
March 13th, 2011


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.
MS Access General Information, MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming, Product Reviews |
No Comments »
March 9th, 2011
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
MS Access Reports, MS Access VBA Programming |
No Comments »
February 15th, 2011
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.
MS Access VBA Programming |
No Comments »
January 17th, 2011
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!
MS Access, MS Access General Information, MS Access VBA Programming |
No Comments »
January 6th, 2011
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.
MS Access General Information, MS Access VBA Programming, MS Excel VBA Programming, MS Office, MS Word VBA Programming |
No Comments »
December 9th, 2010
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
MS Access VBA Programming |
No Comments »
December 6th, 2010
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)
MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming |
No Comments »
December 5th, 2010
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
MS Access Forms, MS Access VBA Programming |
4 Comments »
November 15th, 2010
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
MS Access, MS Access VBA Programming |
No Comments »
November 14th, 2010
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
MS Access VBA Programming |
No Comments »
November 8th, 2010
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).
MS Access Queries, MS Access VBA Programming |
No Comments »
November 1st, 2010
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
MS Access VBA Programming |
No Comments »
October 30th, 2010
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
MS Access VBA Programming |
1 Comment »
October 22nd, 2010
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
MS Access Date/Time, MS Access VBA Programming |
No Comments »
October 19th, 2010
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
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
MS Access VBA Programming |
No Comments »
October 12th, 2010
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
MS Access General Information, MS Access VBA Programming |
No Comments »
October 7th, 2010
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!!!
MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming |
No Comments »
September 29th, 2010
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!
MS Access VBA Programming |
2 Comments »
September 27th, 2010
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.
MS Access VBA Programming |
2 Comments »
September 22nd, 2010
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.
MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming |
No Comments »
September 21st, 2010
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.
MS Access Forms, MS Access VBA Programming |
No Comments »
September 19th, 2010
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.
MS Access Tables, MS Access VBA Programming |
1 Comment »
September 9th, 2010
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
MS Access VBA Programming |
No Comments »