February 2nd, 2012
I had a need to create folders from Access, but needed a means to first validate that the folders names were acceptable as Windows does not allow certain characters and has certain basic rules (refer to the 2 links commented out in the function below for all the details). As such, I created the following simple function which I supply the folder name to and it returns True/False whether the string is acceptable or not. It really wasn’t very difficult and this is the perfect situation in which to utilize the power of regular expression to validate the folder name with!
'---------------------------------------------------------------------------------------
' Procedure : IsInvalidFolderName
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Validates whether the string passed is an acceptable folder name
' 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:
' ~~~~~~~~~~~~~~~~
' sFolderName name of the folder you're wanting to create
'
' Usage:
' ~~~~~~
' IsValidFolderName("MsAccess Databases") will return True
' IsValidFolderName("MsAccess :: Databases") will return False
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2012-Feb-01 Initial Release
'---------------------------------------------------------------------------------------
Function IsValidFolderName(ByVal sFolderName As String) As Boolean
'http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247(v=vs.85).aspx#file_and_directory_names
'http://msdn.microsoft.com/en-us/library/ie/ms974570.aspx
On Error GoTo Error_Handler
Dim oRegEx As Object
'Check to see if any illegal characters have been used
Set oRegEx = CreateObject("vbscript.regexp")
oRegEx.Pattern = "[<>:""/\\\|\?\*]"
IsValidFolderName = Not oRegEx.test(sFolderName)
'Ensure the folder name does end with a . or a blank space
If Right(sFolderName, 1) = "." Then IsValidFolderName = False
If Right(sFolderName, 1) = " " Then IsValidFolderName = False
Error_Handler_Exit:
On Error Resume Next
Set oRegEx = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & vbCrLf & _
"Error Source: IsInvalidFolderName" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
Enjoy!
MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming |
No Comments »
November 9th, 2011
When using the a Treeview control and an expand control the Treeview sets’ the focus at the end/bottom node. So how can you return the focus, in this case ‘select’ the root node? To do so you merely need to use the following bit of code.
Me!TreeviewControlName.Nodes(1).Selected = True
That said, selecting Nodes(1) may not always yield the desireed result. The reason being that if sorting is accomplished after nodes are added the Nodes(1) may no longer be positioned at the top. So what do we do now? There is a solution, but I’m not going to reinvent the wheel on this one. UtterAccess has a sample database with a procedure named GotoFirstNode() that works around the above mentioned little problem. The sample database in question can be found at Treeview Sample With Drag And Drop. It also, covers many other functionalities and is greatly worth checking out.
MS Access Forms, MS Access VBA Programming |
No Comments »
November 8th, 2011
It can become necessary to need to determine the associated label to a given control. It actually is, yet again, very simple to do. Not what I’d call intuitive, but easy once you are aware of the proper synthax to use.
To reference a control’s associated label you use the following synthax
Me.ControlName.Controls(0)
Or
Forms!FormName.Form.ControlName.Controls(0)
So let’s say we wanted to determine a control’s associated label’s caption, we do something along the lines of:
Me.ControlName.Controls(0).Caption
One note of caution however, you need to ensure you implement error handling to trap possible errors (Error number: 2467 – The expression you entered refers to an object that is closed or doesn’t exist) that may arise with control’s that do not have associated labels.
MS Access, MS Access Forms, MS Access VBA Programming |
No Comments »
September 16th, 2011
It can often come handy to be able to quick determine if a Folder/Directory exists or not. Below is a function I created some time ago to do exactly that.
'---------------------------------------------------------------------------------------
' Procedure : FolderExist
' DateTime : 2009-Oct-02 13:51
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Test for the existance of a Folder/Directory
' 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:
' ~~~~~~~~~~~~~~~~
' sFolder - Full path of the folder to be tested for
'---------------------------------------------------------------------------------------
Function FolderExist(sFolder As String) As Boolean
On Error GoTo Error_Handler
If sFolder = vbnullsring Then GoTo Error_Handler_Exit
If Dir(sFolder, vbDirectory) <> vbNullString Then
FolderExist = True
End If
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
If Err.Number <> 52 Then
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: FolderExist" & vbCrLf & _
"Error Description: " & Err.Description, vbCritical, "An Error has Occured
End If
Resume Error_Handler_Exit
End Function
MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming |
No Comments »
September 15th, 2011
One of he most common methods for creating directories/folders in VBA is to use the MkDir statement. For instance:
One quickly learns the limitations of this technique the minute they have to create a directory structure with multiple sub-folders. MkDir can only create 1 directory at a time and cannot create a sub-directory. Hence, assuming that C:\databases does not already exist, the following would not work and will return an error!
MkDir "C:\databases\msaccess\"
If you absolutely want to create such a structure using the MkDir statement you’d have to do so using 2 MkDir statement. For instance:
MkDir "C:\databases\"
MkDir "C:\databases\msaccess\"
Now if you need to merely create 1 or 2 sub-folder MkDir may still be acceptable, but there are cases where this is simply impracticle and another solution needs to be found. Well, I found two possible solutions!
One possible approach can be found at Creating Nested Directories.
The second I found searching through the net and I no longer know the original source of the code (if someone knows e-mail me and I will put credit where it is due). It is a simple API which can create multiple directories in 1 call.
Private Declare Function MakeSureDirectoryPathExists Lib "imagehlp.dll" (ByVal lpPath As String) As Long
Public Sub MakeFullDir(strPath As String)
If Right(strPath, 1) <> "\" Then strPath = strPath & "\" 'Optional depending upon intent
MakeSureDirectoryPathExists strPath
End Sub
Another possible solution, if someone wanted to tinker a little would be to merely parse the path into it’s directories and the using the DIR statement evaluate and create the directories where need be. Shouldn’t be that hard, but I haven’t taken the time to do this (maybe one day I will and will update this post then).
Okay, so it bothered me and I had to quickly put something together to stop my brain from churning! Below is what I pieced together rapidly. It is missing proper variable definitions (DIM statements) and error handling, but from my very brief testing, it does appear to work and doesn’t require any APIs! 100% VBA.
Public Sub MyMkDir(sPath As String)
Dim iStart As Integer
Dim aDirs As Variant
Dim sCurDir As String
Dim i As Integer
If sPath <> "" Then
aDirs = Split(sPath, "\")
If Left(sPath, 2) = "\\" Then
iStart = 3
Else
iStart = 1
End If
sCurDir = Left(sPath, InStr(iStart, sPath, "\"))
For i = iStart To UBound(aDirs)
sCurDir = sCurDir & aDirs(i) & "\"
If Dir(sCurDir, vbDirectory) = vbNullString Then
MkDir sCurDir
End If
Next i
End If
End Sub
As you can see, there are numerous way to handles this issue. Hopefully this helped answer a question for a few of you out there!
MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming |
No Comments »
August 31st, 2011
So you merely would like to navigate to a given folder! Well, as usual, there are numerous ways to accomplish this.
Method 1 – FollowHyperlink Method
The first method is to use the FollowHyperlink Method. This is a great technique because it requires minimal coding and will open the folder in the user’s default software of choice. The code would look something like:
Application.FollowHyperlink "C:\Program Files\Microsoft Games"
Method 2 – Shell Function
You can use the Shell Function to specify which program to use and pass it whatever variable that application accepts. So for our needs, we can merely use Windows explorer to open the folder we are interested in. The code would look something like:
Dim sPath as String
sPath = "C:\Program Files\Microsoft Games"
Shell "C:\WINDOWS\explorer.exe """ & sPath & "", vbNormalFocus
In the case of the FollowHyperlink Method, you obviously have to ensure that your users’ actually have the program you are trying to utilize to open the folder and be careful with the exe location since it may change depending on OS versions, but you can easily build a more robust function to handle all these exceptions/cases.
MS Access VBA Programming |
No Comments »
August 19th, 2011
Another interesting question I was once asked on an Access forum was how can one retrieve a random record in a form?
I was actually perplexed as to how to approach this request, but it really isn’t that complicated at the end of the day. The code below demonstrates one possible method.
'---------------------------------------------------------------------------------------
' Procedure : GetRndRec
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Goto/retrieve a random record
' 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 2008-Dec-21 Initial Release
'---------------------------------------------------------------------------------------
Function GetRndRec()
On Error GoTo Error_Handler
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim tblName As String 'Table to pull random record from
Dim iRecCount As Long 'Number of record in the table
Dim iRndRecNum As Integer
tblName = "YourTableName"
Set db = CurrentDb()
Set rs = db.OpenRecordset(tblName, dbOpenSnapshot, dbReadOnly, dbReadOnly)
If rs.RecordCount <> 0 Then 'ensure there are records in the table before proceeding
With rs
rs.MoveLast 'move to the end to ensure accurate recordcount value
iRecCount = rs.RecordCount
iRndRecNum = Int((iRecCount - 1 + 1) * Rnd + 1) 'Get Random Rec Number to use
rs.MoveFirst
.Move CLng(iRndRecNum)
GetRndRec = ![YourFieldName]
End With
End If
Resume Error_Handler_Exit
On Error Resume Next
'Cleanup
rs.Close
Set rs = Nothing
Set db = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: GetRndRec" & vbCrLf & _
"Error Description: " & Err.Description _
, vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function
MS Access Forms, MS Access Tables, MS Access VBA Programming |
No Comments »
August 18th, 2011
This was the question put forth by someone on an Access Forum recently and I thought I’d share one possible way to determine this.
This is a brute force method, but it works! I simply loop through all the tables one by one and loop through all the fields within each table one by one. It is that simple. Here is the code.
'---------------------------------------------------------------------------------------
' Procedure : WhereFieldLocated
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Determine/Locate in which Table(s) a field is located
' 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: The name of the field you are trying to locate
'
' Usage:
' ~~~~~~
' WhereFieldLocated "Filed1"
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2011-Aug-17 Initial Release
'---------------------------------------------------------------------------------------
Function WhereFieldLocated(sFieldName As String)
Dim db As DAO.Database
Dim td As DAO.TableDefs
Dim fld As Field
Set db = CurrentDb()
Set td = db.TableDefs
For Each t In td 'loop through all the tables in the database
If Left(t.Name, 4) = "MSys" Then GoTo Continue
For Each fld In t.Fields 'loop through all the fields of the table
If fld.Name = sFieldName Then
Debug.Print t.Name
End If
Next
Continue:
Next
Set td = Nothing
Set db = Nothing
End Function
MS Access Tables, MS Access VBA Programming |
1 Comment »
August 17th, 2011
I recently helped an individual in an Access Forum who wanted to know how to open a password protected Excel workbook/spreadsheet. Although the question was Access specific, the code can easily be used in Word, PowerPoint,…
'---------------------------------------------------------------------------------------
' Procedure : OpenPwdXLS
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Open a password protected Excel Workbook
' 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:
' ~~~~~~~~~~~~~~~~
' strWrkBk : Full path and Filename of the Excel Workbook to open
' sPwd : Password to unlock/open the Workbook in question
'
' Usage:
' ~~~~~~
' OpenPwdXLS "C:\Testing\book1.xls", "MyPassword"
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2009-Jun-11 Initial Release
'---------------------------------------------------------------------------------------
Function OpenPwdXLS(strWrkBk As String, sPwd As String)
'Use late binding so no reference libraries are required
On Error GoTo Error_Handler
Dim xlApp As Object
Dim xlWrkBk As Object
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application") 'Bind to existing instance of Excel
If Err.Number <> 0 Then
'Could not get instance of Excel, so create a new one
Err.Clear
On Error GoTo Error_Handler
Set xlApp = CreateObject("excel.application")
Else
On Error GoTo Error_Handler
End If
xlApp.Visible = True 'make excel visible to the user
Set xlWrkBk = xlApp.Workbooks.Open(strWrkBk, , , , sPwd)
'... the rest of your code goes here
Error_Handler_Exit:
On Error Resume Next
Set xlWrkBk = Nothing
Set xlApp = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: OpenPwdXLS" & vbCrLf & _
"Error Description: " & Err.Description _
, vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function
MS Access - Excel Automation, MS Access VBA Programming, MS Word VBA Programming |
No Comments »
June 22nd, 2011
I ran into a particular problem with an associate of mine not too long ago and thaught I’d share the problem & solution with everyone. He had been given an .accdb database that evidently came from an mdb originally as it contained a custom command bar. The problem being that 2007/2010 support such command bars by simply placing them in the Add-Ins tab. However, this issue lies with the fact that 2007/2010 no longer offer the general user/developer a method to edit such command bars as they are considered to be deprecated. My associate wanted to merely delete this command bar and replace it with a proper custom Ribbon Tab. So how do you delete a command bar? Good question! In 2007/2010 the only solution is to use VBA. The actual code to delete a command bar is very simple, as shown below.
Application.CommandBars("CommandBarName").Delete
Sound simple you say. Sadly, no! Once again because MS has decided no longer provide any tools to work with these ‘elements’, you cannot identify the name of the Add-Ins toolbars. if you can’t identify it, you can’t delete it! So what to do? Well, I came up with another simple solution and created a procedure that merely listed all the command bars within the current database. then we could go through the list and identify the one that we needed to delete. Below are two slightly different procedures. The first one is a more general version which merely lists all of the command bars within the database, the second is a slightly more refined version that only lists open command bars. Since the Add-Ins Tab was active, the 2nd procedure was a better option in our case and thus reduce the list we had to sift through (our list went from 202 items to 4 – from there it was easy to determine which one we needed to eliminate).
'---------------------------------------------------------------------------------------
' Procedure : ListCmdBars
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Lists all the command bars within the current database
' Compatibility: Works with MS Access, Word, Excel, PowerPoint, ...
' 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 2011-June-22 Initial Release
'---------------------------------------------------------------------------------------
Function ListCmdBars()
On Error GoTo Error_Handler
Dim i As Long
Dim sCmdBar As CommandBar
Debug.Print "Number", "Name", "Visible", "Built-in"
For i = 1 To Application.CommandBars.Count
Set sCmdBar = Application.CommandBars(i)
Debug.Print i, sCmdBar.Name, sCmdBar.Visible, sCmdBar.BuiltIn
Next i
Error_Handler_Exit:
On Error Resume Next
Set sCmdBar = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ListCmdBars" & vbCrLf & _
"Error Description: " & Err.Description, vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function
'---------------------------------------------------------------------------------------
' Procedure : ListVisibleCmdBars
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Lists all the visible command bars within the current database
' Compatibility: Works with MS Access, Word, Excel, PowerPoint, ...
' 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 2011-June-22 Initial Release
'---------------------------------------------------------------------------------------
Function ListVisibleCmdBars()
On Error GoTo Error_Handler
Dim i As Long
Dim j As Long
Dim sCmdBar As CommandBar
Debug.Print "Number", "Name", "Visible", "Built-in"
For i = 1 To Application.CommandBars.Count
Set sCmdBar = Application.CommandBars(i)
If sCmdBar.Visible = True Then
j = j + 1
Debug.Print j, sCmdBar.Name, sCmdBar.Visible, sCmdBar.BuiltIn
End If
Next i
Error_Handler_Exit:
On Error Resume Next
Set sCmdBar = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occured." & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: ListVisibleCmdBars" & vbCrLf & _
"Error Description: " & Err.Description, vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function
So as you can see, it is still possible to manipulate command bars in MS Access 2007/2010, but it can now only be done through the use of VBA code!
Thanks to a post by Albert Kallal, a fellow MVP, we also found out that it could be necessary to execute the following
CurrentDb.Properties.Delete("StartUpMenuBar")
and in our case it was required as even after deleting the commandbar in question we were still receiving the error message
… can’t find the object ‘MyCommandBarName.’
If ‘MyCommandBarName’ is a new macro or macro group, make sure you have saved it and that you have type its name correctly
MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming |
No Comments »
June 13th, 2011
Similarily to deleting tables, if you have ever needed to delete all the queries from a database, it can be a long tedeous task as Access does not allow multiple Object selection. So you have to delete each query, one by one!!! Hence, why I created the simple little procedure below.
'---------------------------------------------------------------------------------------
' Procedure : DeleteAllQueries
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Deletes all the queries from the active 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).
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2011-Jun-10 Initial Release
'---------------------------------------------------------------------------------------
Function DeleteAllQueries()
On Error GoTo Error_Handler
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
DoCmd.SetWarnings False
Set db = CurrentDb
For Each qdf In db.QueryDefs
DoCmd.DeleteObject acQuery, qdf.Name
Next
Error_Handler_Exit:
DoCmd.SetWarnings True
Set qdf = Nothing
Set db = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: DeleteAllQueries" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
MS Access Queries, MS Access VBA Programming |
1 Comment »
June 10th, 2011
Ever needed to delete the linked tables out of your database. Sadly Access does not allow one to make multiple selection of Access object to perform batch actions on, such as delete. So if you have quite a few tables to delete it can be frustrating and a waste of time. This is why I create the very simply procedure found below.
'---------------------------------------------------------------------------------------
' Procedure : DeleteAttachedTbls
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Deletes all the linked tables from the active database. It only removes
' the links and does not actually delete the tables from the back-end
' 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).
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2011-Jun-10 Initial Release
'---------------------------------------------------------------------------------------
Function DeleteAttachedTbls()
On Error GoTo Error_Handler
Dim db As DAO.Database
Dim tdf As DAO.TableDef
DoCmd.SetWarnings False
Set db = CurrentDb()
For Each tdf In db.TableDefs
If (tdf.Attributes And dbAttachedTable) = dbAttachedTable Then
DoCmd.DeleteObject acTable, tdf.Name
End If
Next
Error_Handler_Exit:
DoCmd.SetWarnings True
Set tdf = Nothing
Set db = Nothing
Exit Function
Error_Handler:
MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: DeleteAttachedTbls" & vbCrLf & _
"Error Description: " & Err.Description, _
vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
MS Access Tables, MS Access VBA Programming |
2 Comments »
June 8th, 2011
You can use the following procedure to extract the path from a full file name. You supply the file address, complete file path and file name (ie: “C:\Documents and Settings\User\Desktop\Details.txt”) and it will return the file name (ie: “Details.txt”)
'---------------------------------------------------------------------------------------
' Procedure : GetFileName
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Return the filename from a path\filename input
' 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:
' ~~~~~~~~~~~~~~~~
' sFile - string of a path and filename (ie: "c:\temp\test.xls")
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2008-Feb-06 Initial Release
'---------------------------------------------------------------------------------------
Function GetFileName(sFile As String)
On Error GoTo Err_Handler
GetFileName = Right(sFile, Len(sFile) - InStrRev(sFile, "\"))
Exit_Err_Handler:
Exit Function
Err_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: GetFileName" & vbCrLf & _
"Error Description: " & Err.Description, vbCritical, "An Error has Occured!"
GoTo Exit_Err_Handler
End Function
MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming |
No Comments »
June 7th, 2011
You can use the following procedure to extract the path from a full file name. You supply the file address, complete file path and file name (ie: “C:\Documents and Settings\User\Desktop\Details.txt”) and it will return the path (ie: “C:\Documents and Settings\User\Desktop\”)
'---------------------------------------------------------------------------------------
' Procedure : GetFilePath
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Return the path from a path\filename input
' 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:
' ~~~~~~~~~~~~~~~~
' sFile - string of a path and filename (ie: "c:\temp\test.xls")
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2008-Feb-06 Initial Release
'---------------------------------------------------------------------------------------
Function GetFilePath(sFile As String)
On Error GoTo Err_Handler
GetFilePath = Left(sFile, InStrRev(sFile, "\"))
Exit_Err_Handler:
Exit Function
Err_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: GetFilePath" & vbCrLf & _
"Error Description: " & Err.Description, vbCritical, "An Error has Occured!"
GoTo Exit_Err_Handler
End Function
MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming |
No Comments »
June 6th, 2011
Ever simply wanted to append data into an existing text file? The procedure below does exactly that. Simply supply the full path and file name of the text file to append to, and supply the string to append and voila!
'---------------------------------------------------------------------------------------
' Procedure : AppendTxt
' DateTime : 2007-Mar-06 10:14
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Output Data to an external file (*.txt or other format)
' ***Do not forget about access' DoCmd.OutputTo Method for
' exporting objects (queries, report,...)***
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFile - name of the file that the text is to be output to including the full path
' sText - text to be output to the file
'---------------------------------------------------------------------------------------
Function AppendTxt(sFile As String, sText As String)
On Error GoTo Err_Handler
Dim FileNumber As Integer
FileNumber = FreeFile ' Get unused file number
Open sFile For Append As #FileNumber ' Connect to the file
Print #FileNumber, sText ' Append our string
Close #FileNumber ' Close the file
Exit_Err_Handler:
Exit Function
Err_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: AppendTxt" & vbCrLf & _
"Error Description: " & Err.Description, vbCritical, "An Error has Occured!"
GoTo Exit_Err_Handler
End Function
MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming |
No Comments »
June 5th, 2011
Here is another simple procedure that allows one to verify/check if a file exists or not.
'---------------------------------------------------------------------------------------
' Procedure : FileExist
' DateTime : 2007-Mar-06 13:51
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Test for the existance of a file; Returns True/False
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' strFile - name of the file to be tested for including full path
'---------------------------------------------------------------------------------------
Function FileExist(strFile As String) As Boolean
On Error GoTo Err_Handler
FileExist = False
If Len(Dir(strFile)) > 0 Then
FileExist = True
End If
Exit_Err_Handler:
Exit Function
Err_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: FileExist" & vbCrLf & _
"Error Description: " & Err.Description, vbCritical, "An Error has Occured!"
GoTo Exit_Err_Handler
End Function
MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming |
No Comments »
June 4th, 2011
It still amazes me how Microsoft can develop these complexe applications but seems to overlook some simple functions that they should included within them to aid developers… But then, as demonstrated with the release of Office 2007 and 2010, Microsoft is not interested in the developer, they are only interested in the end-user’s opinion. Not productivity (that went down, about 30-40% drop in efficiency, the tubes with their change of format)! So all that matters is looks, the feel – very superficial (rant over)!!!
This will be the first in a series of procedure that I will be posting in the coming months in which I hope to demonstrate how you can use the ‘Microsoft Visual Basic for Application Extensibility’ library in conjuntion with the power of VBA to learn more, control more, manipulate more the VBE.
In this first post, I simply wanted to create a simple procedure that would give me a breakdown of my Access project. I wanted to return a listing of procedure per module with a line count. As you can see, the ‘Microsoft Visual Basic for Application Extensibility’ enable us to perform this task with ease with little code. Heck, half of the code below is to write to the generated text file!
'---------------------------------------------------------------------------------------
' Procedure : GetVBEDeatils
' Author : CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Goes throught the VBE and creates a text file which give a brief listing
' of the procedures within each module and a line count for each
' 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).
' Requirements: reference to the Microsoft Visual Basic for Application Extensibility
' library.
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2011-June-04 Initial Release
'---------------------------------------------------------------------------------------
Function GetVBEDeatils()
Dim vbProj As VBProject
Dim vbComp As VBComponent
Dim vbMod As CodeModule
Dim sProcName As String
Dim pk As vbext_ProcKind
Dim FileNumber As Integer
Dim strFile As String
Const vbNormalFocus = 1
'Where do youwant the text file created
strFile = "C:\VBEDetails.txt"
If Len(Dir(strFile)) > 0 Then Kill strFile
FileNumber = FreeFile 'Get unused file number.
Open strFile For Append As #FileNumber 'Create file name.
For Each vbProj In Application.VBE.VBProjects 'Loop through each project
Print #FileNumber, vbProj.Name
For Each vbComp In vbProj.VBComponents 'Loop through each module
Set vbMod = vbComp.CodeModule
Print #FileNumber, " " & vbComp.Name & " :: " & vbMod.CountOfLines & " total lines"
Print #FileNumber, " " & String(80, "*")
iCounter = 1
Do While iCounter < vbMod.CountOfLines 'Loop through each procedure
sProcName = vbMod.ProcOfLine(iCounter, pk)
If sProcName <> "" Then
Print #FileNumber, " " & sProcName & " :: " & vbMod.ProcCountLines(sProcName, pk) & " lines"
iCounter = iCounter + vbMod.ProcCountLines(sProcName, pk)
Else
iCounter = iCounter + 1
End If
Loop
Print #FileNumber, ""
Next vbComp
Next vbProj
Close #FileNumber 'Close file.
Set vbMod = Nothing
'Open the generated text file
Shell "cmd /c """ & strFile & """", vbNormalFocus
End Function
MS Access, MS Access VBA Programming, MS Excel VBA Programming, MS Word VBA Programming |
1 Comment »
May 26th, 2011
It is easy during development to inadvertantly change the page setup setting of a report (or reports) to use a local printer. Once deployed your database will throw an error message nagging the user to switch from the one specified to his default printer. Why not avoid this issue altogether?! I created a very simply procedure that simply go through the report collection and ensure that all the report are set to use the default printer. I then call this procedure (along with turn off SubDataSheets, deactivate AllowZeroLength property, etc.) in my deploy procedure I run before deploying any database to my users.
'---------------------------------------------------------------------------------------
' Procedure : RptPrntSetDef
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Ensure that all the report apge setups are set to use the Default Printer
' 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 2011-05-23 Initial Release
'---------------------------------------------------------------------------------------
Sub RptPrntSetDef()
On Error GoTo Error_Handler
Dim db As DAO.Database
Dim DbP As Object
Dim DbO As AccessObject
Set db = CurrentDb
DoCmd.SetWarnings False
Debug.Print "RptPrntSetDef Begin"
Debug.Print "================================================================================"
'Check Reports
Set DbP = application.CurrentProject
For Each DbO In DbP.AllReports
DoCmd.OpenReport DbO.Name, acDesign
If Reports(DbO.Name).Report.UseDefaultPrinter = False Then
Debug.Print "Editing Report '" & DbO.Name & "'"
Reports(DbO.Name).Report.UseDefaultPrinter = True
DoCmd.Close acReport, DbO.Name, acSaveYes
Else
DoCmd.Close acReport, DbO.Name, acSaveNo
End If
Next DbO
Debug.Print "================================================================================"
Debug.Print "RptPrntSetDef End"
Error_Handler_Exit:
On Error Resume Next
DoCmd.SetWarnings True
Set DbO = Nothing
Set DbP = Nothing
Set db = Nothing
Exit Sub
Error_Handler:
MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
Err.Number & vbCrLf & "Error Source: RptPrntSetDef" & vbCrLf & "Error Description: " & _
Err.Description, vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Sub
MS Access Reports, MS Access VBA Programming |
No Comments »
May 25th, 2011
Here is a simple bit of code that permits you to hide the MS Access’ main object browser, to stop nosy users from accessing tables, queries, etc…
DoCmd.SelectObject acTable, , True
DoCmd.RunCommand acCmdWindowHide
In conjunction with the code to determine whether the user is running the runtime or full version of Access (see MS Access – Determine if Runtime or Full Version
) you could insert a section of code such as:
If SysCmd(acSysCmdRuntime) = False Then
DoCmd.SelectObject acTable, , True
DoCmd.RunCommand acCmdWindowHide
End If
This would also be a good place to enable any custom command bars/ribbons and/or disable any built-in command bars/ribbons…
MS Access Forms, MS Access Queries, MS Access Reports, MS Access Tables, MS Access VBA Programming |
No Comments »
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 »