Archive for ‘MS Access VBA Programming’

February 2nd, 2012

VBA – Directory/Folder Name Validation

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!

November 9th, 2011

MS Access – VBA – Select the Treeview Root Node

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.

November 8th, 2011

MS Access – VBA – Determine a Control’s Associated Label

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.

September 16th, 2011

VBA – Determine if a Folder/Directory Exists or Not

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 &lt;&gt; 52 Then
        MsgBox "The following error has occured" &amp; vbCrLf &amp; vbCrLf &amp; _
           "Error Number: " &amp; Err.Number &amp; vbCrLf &amp; _
           "Error Source: FolderExist" &amp; vbCrLf &amp; _
           "Error Description: " &amp; Err.Description, vbCritical, "An Error has Occured
    End If
    Resume Error_Handler_Exit
End Function
September 15th, 2011

VBA – Create Directory Structure/Create Multiple Directories/Create Nested Directories

One of he most common methods for creating directories/folders in VBA is to use the MkDir statement. For instance:

MkDir "C:\databases\"

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!

August 31st, 2011

MS Access – VBA – Open/Browse a Folder

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.

August 19th, 2011

MS Access – VBA – Retrieve a Random Record

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

August 18th, 2011

MS Access – VBA – Determine in Which Table a Field is Located

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

August 17th, 2011

VBA – Open a Password Protected Excel WorkBook

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

June 22nd, 2011

VBA – List Application Command Bars

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

June 13th, 2011

MS Access – VBA – Delete all the Queries

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" &amp; vbCrLf &amp; vbCrLf &amp; _
           "Error Number: " &amp; Err.Number &amp; vbCrLf &amp; _
           "Error Source: DeleteAllQueries" &amp; vbCrLf &amp; _
           "Error Description: " &amp; Err.Description, _
           vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function
June 10th, 2011

MS Access – VBA – Delete all Linked Tables

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" &amp; vbCrLf &amp; vbCrLf &amp; _
           "Error Number: " &amp; Err.Number &amp; vbCrLf &amp; _
           "Error Source: DeleteAttachedTbls" &amp; vbCrLf &amp; _
           "Error Description: " &amp; Err.Description, _
           vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function
June 8th, 2011

VBA – Extract the File Name from a Complete File Path and Name

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

June 7th, 2011

VBA – Extract the Path from a Complete File Path and Name

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

June 6th, 2011

VBA – Append Text to a Text File

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

June 5th, 2011

VBA – Determine if a File Exists or Not

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

June 4th, 2011

VBA – VBE Enumerate Modules, Procedures and Line Count

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

May 26th, 2011

MS Access – VBA – Set Report to Use Default Printer

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

May 25th, 2011

MS Access – VBA – Hide Object Pane

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…

April 8th, 2011

MS Access – VBA – Determine Where a Field Is Used

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

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

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

April 7th, 2011

MS Access – VBA – Relink Back-End Tables

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

Below are a few useful link to get you going:

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

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

March 13th, 2011

FMS Total Visual SourceBook Review

FMSTotal Visual SourceBook

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

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

 

So what did I think of the TVSB?

Cons:

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

 

Pros:

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

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

March 9th, 2011

MS Access – Report – Change a Report’s RecordSource

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

'---------------------------------------------------------------------------------------
' Procedure : RedefRptSQL
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Redefine an existing report's recordsource
'             Requires opening the form in design mode to make the changes
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sRptName    ~ Name of the Query to redefine the SQL statement of
' sSQL        ~ SQL Statement to be used to refine the query with
'
' Usage:
' ~~~~~~
' RedefRptSQL "Report1", "SELECT * FROM tbl_Contacts ORDER BY LastName;"
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2009-07-13                 Initial Release
'---------------------------------------------------------------------------------------
Function RedefRptSQL(sRptName As String, sSQL As String)
On Error GoTo Error_Handler
    Dim Rpt     As Report
 
    DoCmd.OpenReport sRptName, acViewDesign, , , acHidden 'Open in design view so we can
                                                          'make our changes
    Set Rpt = Application.Reports(sRptName)
    Rpt.RecordSource = sSQL                               'Change the RecordSource
    DoCmd.Close acReport, sRptName, acSaveYes             'Save our changes

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

February 15th, 2011

MS Access – VBA – Minimize/Maximize Access Application

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

 

Minimize/Maximize and Restore the MS Access Application Window

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

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

 

Completely Hide the MS Access Application Window

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

January 17th, 2011

MS Access – VBA – The Save Operation Failed

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

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

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

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

I hope this helps someone else in the same perdicament!