Why a copyright notice in the VBA procedures

I received a nice e-mail today from Jack Stockton:

Why such a big copyright notice in your sample code?
There is really nothing that is special and not available form many other sources.
It is one thing to put your name in the code, but it is hardly copyright material.

  • For one thing, when I started the site years ago, there were not as many sources of information as today.
  • I doubt that you will find everything found here in one, easily searchable location.
  • A lot of code available on certain other sites has been copied from sites such as this one.  Even more of a reason to have a notice.  If people actually respected where content came from, it wouldn’t be as necessary.
  • Although there are pretty basic functions that you can find easily by searching, there are also some that you will not find elsewhere and have taken considerable amounts of time to figure out…  With well over 200 posts on a variety of MS Access subjects, I doubt it is all easily found elsewhere.  Perhaps sites that merely repost other website’s content.
  • This header also ensure, that one can easily remember the source.
  • You’ll notice that I put no restriction on usage whatsoever (none of this personal use only…), so I think asking to keep the source where you got the info from isn’t so much to ask.

This is a site I developed on my spare time to try and help out others, free of charge (I assume the cost of the website, hosting, … and don’t have advertising, pop-ups, malware, third-party tracking cookies, …). If asking someone to keep a header in a module (that realistically no other person will ever see but the developer) is such an inconvenience…! Really, this is what you consider a problem worthy of an e-mail. Life must be quite boring for you.

It is exactly this type of e-mail, when simply trying to help others, that makes me be on the verge of just shutting down my site altogether.  Amazing how in one broad statement you can degrade an entire site, thousands of hours of work…  What is the expression: “If you don’t have anything nice to say, don’t say anything at all.”.  You could learn something from that saying.  Actually, you could learn a lot from it!!!

Thanks for the support Jack.  Instead of criticizing others, feel free to create your own site and do better, it could only help the Access community at large!  But then again it is much easier to criticize for no real reason.

— Little did I know Jack was an MVP. So this is how one MVP supports another. Says a lot about a person! —

The Source/La Source Price Match Guarantee a farce at Best

I recently wanted to purchase an analog-digital converter. After doing my research, I determined the model I wanted and was surprised to see that, locally, The Source was the only store to carry it. After a little more digging, I found another retailer in the East End of Montreal that carried it for 20$ less. After briefly seeing that The Source had a Price Match policy, I went out confident that they would merely match what the other store was selling the exact same model for. Was I ever wrong!

Their Price Match Guarantee is as follows (Taken from http://www.thesource.ca/sitelets/pricematch/en/ on 20121107 (minus a few fixed spelling mistakes – you’d think they could run spell check)):

Price Match Guarantee
on any competitor’s price
The Source will match any advertised price on an identical product currently advertised in Canada!

Our Price Match Guarantee
The Source’s Price Match Guarantee is our assurance that you will get the best price on products you purchase at The Source. If you find a lower, currently advertised price from a Canadian retailer we will match that price on an identical product (including the year, model number, warranty, components, bundling/kitting or any service plans that may be included with the product).

Simply present proof that the item you wish to buy from The Source is being advertised at a price lower than The Source’s retail price. A Sales Associate will need to verify that the item is in stock and available for immediate sale, at which point The Source will sell you that item at the lower price.

Terms and Conditions
The Source will match any advertised price on an identical product (including the year, model number, warranty, components, bundling/kitting or any service plans that may be included with the product) currently advertised in Canada. This offer does not apply to products advertised during Black friday, Cyber Week, Boxing Week, or on the Internet; discontinued, liquidation, closed-out or clearance products, bonus or free offers; private sales; trade-in sales; special orders, “limited quantities” or “one of a kind” offers; “after rebate pricing”; coupon; club or wholesale pricing; store credits; gift cards or similar credits; and competitors’ misprinted advertising or out-of-province/territory advertising. This offer also does not apply to advertisements for subscription services, including but not limited to wireless, telephone, internet, satellite or any other similar subscription service.

This offer does not apply to advertisement for cellular handsets, tablets, receivers and internet devices, except for Bell or Virgin Mobile advertisement for such products.

This offer applies to existing in-store stock only and does not apply to previously purchased items. Items sold in “as-is” condition including refurbished merchandise, floor models, open stock and scratch-and-dent items are excluded from this offer. The Source reserves the right to verify competitor pricing and availability of price match items, limit quantities of price match items, and to revoke this promotion, and change its terms and conditions, without advance notice. Price match must be requested by the consumer from The Source at the time of purchase or within 48 hours of receipt of the item by the consumer.

Sadly, in my experience, The Source is more interested in playing legalize word games than in truly providing a Price Match with competitors.  What is boils down to is they will only match prices of items sent out in flyers, with a whole slew of exceptions (limited quantities,…).  Since only a handful of companies actually send out flyers (Best Buy, Future Shop, Bureau en Gros, Sears – at least in my neighborhood), they need only ensure they are staying in-line with these few companies to supposedly maintain their Price Match guarantee.

In comparison, I have now been twice to Best Buy were they have matched, without question, the price I found online of various competitors (forget flyers).  No hassle, matched it, and gave me an extra 10% off!  That is what you call customer service!!!

So at the end of the day, The Source has lost me as a customer for life and I have learnt, and hopefully you as well, that their Price Match guarantee only applies if you manage to weasel your way through a whole slew of exceptions.  So they stack the deck in such a way that very few people will ever actually qualify for meeting the requirements of their Price Match guarantee.  I consider this to be not valuing your clientele and just poor customer service.  Next time I will purchase the item online at Amazon, so much for supporting local business.  It is too bad, because it is this type of game, that costs a business its’ reputation.

All of this to say, if you plan on trying to get The Source to actually enforce their Price Match guarantee, good luck.  What they consider Price Matching and what the average person considers Price Matching appear to be 2 completely different things!  What they state in their first statement: “The Source will match any advertised price on an identical product currently advertised in Canada!” does not match up with the rest of their guarantee.  It also shows how much they have fallen behind the times when they will not honor any Internet based prices!!!  What world are they living in?!  Seriously, Online is where things are at.

I guess The Source doesn’t want my business.  I’ll take my money elsewhere from this day forth.

MS Excel – VBA – Number of Used Columns in WorkSheets

Sometimes you need to loop through all the columns within a given worksheet, so you need to first ascertain what is the last column in the worksheet. So how can one do this reliably?

Well, if all you columns are visible, then you can use code such as:

Dim iLastCol        As Long
iLastCol = Sheets("YourSheetName").Cells(7, Sheets("YourSheetName").Columns.Count).End(xlToLeft).Column

Or

Dim iLastCol        As Long
iLastCol = ActiveSheet.Cells(7, ActiveSheet.Columns.Count).End(xlToLeft).Column

Now that is all fine and dandy, if all your columns are visible, but what happens when you need to identify the last column even if those column may or may not be visible? Once again, no major problem. We just need to tweak our code to something like:

Dim iLastCol        As Long
iLastCol = Sheets("YourSheetName").UsedRange.Columns(Sheets("YourSheetName").UsedRange.Columns.Count).Column

Or

Dim iLastCol        As Long
iLastCol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRange.Columns.Count).Column

Now both can be very useful in different situations. Just beware that there is a difference depending on whether or not you want to include hidden columns in your count/loop.

MS Excel – VBA – Hide all WorkSheets

In the same thought process as my previous post MS Excel – VBA – Unhide as WorkSheets in a WorkBook, below is are two simply procedures. The first will hide all the WorkSheets within the WorkBook, however they can still be made visible by the user through the standard Excel menus. The second one, hides all the WorkSheets but this time they are ‘veryhidden’, which means there is no way for the user to unhide them without using VBA to do so. Even if they use the standard menus the ‘very hidden’ sheets will not appear.

'---------------------------------------------------------------------------------------
' Procedure : hideAllWs
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Hide all the worksheets except for the active sheet
' 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         2012-Oct-25                 Initial Release
'---------------------------------------------------------------------------------------
Function hideAllWs()
On Error GoTo Error_Handler
    Dim WS              As Worksheet

    For Each WS In Worksheets
        If WS.Name <> ActiveSheet.Name Then WS.visible = xlSheetHidden
    Next WS

Error_Handler_Exit:
    On Error Resume Next
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Source: hideAllWs" & vbCrLf & _
            "Error Description: " & Err.Description, _
            vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function
'---------------------------------------------------------------------------------------
' Procedure : VeryhideAllWs
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Hide all the worksheets except for the active sheet
' 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         2012-Oct-25                 Initial Release
'---------------------------------------------------------------------------------------
Function VeryhideAllWs()
On Error GoTo Error_Handler
    Dim WS              As Worksheet

    For Each WS In Worksheets
        If WS.Name <> ActiveSheet.Name Then WS.visible = xlSheetVeryHidden
    Next WS

Error_Handler_Exit:
    On Error Resume Next
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Source: VeryhideAllWs" & vbCrLf & _
            "Error Description: " & Err.Description, _
            vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

You’ll notice in both routines that it will not hide the active worksheet. That is because you can’t, it will err. So you need to set focus on whatever worksheet you want to remain visible and then run it to hide all the other sheets in the workbook.

MS Excel – VBA – Unhide All WorkSheets in a WorkBook

I created a monster. Well sort of. I created a security routine that controls the visibility of worksheet based on the current user. This is great, but as the developer and tester, impersonating other users, I didn’t want to have to make 70+ Worksheets visible again. Even more so since, I was using the xlSheetVeryHidden visibility property making it impossible to restore manually! So what to do. Easy, create a very simple routine to loop through all the WorkSheets of the current WorkBook and set them all visible again.

'---------------------------------------------------------------------------------------
' Procedure : UnhideAllWs
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Loop through all the WorkSheets of the current WorkBook and set them all
'             to visible.
' 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         2012-Oct-25                 Initial Release
'---------------------------------------------------------------------------------------
Function UnhideAllWs()
On Error GoTo Error_Handler
    Dim WS              As Worksheet

    For Each WS In Worksheets
        WS.visible = xlSheetVisible
    Next WS

Error_Handler_Exit:
    On Error Resume Next
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf  _
            "Error Source: UnhideAllWs" & vbCrLf & _
            "Error Description: " & Err.Description, _
            vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

MS Access – VBA – Requery a Form While Remaining on the Same Record

Have you ever wanted to requery a form after a user inserts a new record or modifies an existing record, to perhaps re-order things, but wanted to stay on the same record that you currently are on once the requery was done? Perhaps to synchronize changes made by other users, or on another form.

My Initial Idea

The fact of the matter is that it truly isn’t very complex to do.  Below is some straight forward code to do so and you’d need only add it to a Form’s After Insert event or a control’s After Update event.

    Dim rs              As DAO.Recordset
    Dim pk              As Long

    pk = Me.PrimaryKeyFieldName
    Me.Requery
    Set rs = Me.RecordsetClone
    rs.FindFirst "[PrimaryKeyFieldName]=" & pk
    Me.Bookmark = rs.Bookmark
    Set rs = Nothing

Now there is nothing wrong with the code above, but instead of putting such code inside each and every form’s After Insert event and every control’s After Update event, I thought to myself that I should be able to create a simple, re-useable function that I could call, and achieve the same desired effect. Below is that function.

'---------------------------------------------------------------------------------------
' Procedure : FrmRequery
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Requery the form to apply the chosen ordering,
'               but ensure we remain on the current record after the requery
' 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:
' ~~~~~~~~~~~~~~~~
' frm       : The form to requery
' sPkField  : The primary key field of that form
'
' Usage:
' ~~~~~~
' Call FrmRequery(Me, "Id")
' Call FrmRequery(Me, "ContactId")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2012-Oct-19                 Initial Release
'---------------------------------------------------------------------------------------
Sub FrmRequery(frm As Form, sPkField As String)
    On Error GoTo Error_Handler
    Dim rs              As DAO.Recordset
    Dim pk              As Long

    pk = frm(sPkField)
    frm.Requery
    Set rs = frm.RecordsetClone
    rs.FindFirst "[" & sPkField & "]=" & pk
    frm.Bookmark = rs.Bookmark

Error_Handler_Exit:
    On Error Resume Next
    Set rs = Nothing
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Source: FrmRequery" & vbCrLf & _
            "Error Description: " & Err.Description, _
            vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

The beauty of the above function is that you can copy it into a standard module, and then call it with a single line of code in as many events as you choose. You could even build an event expression, thus not requiring any VBA events, if you so wished to.

A Much Simpler Solution!

Another option would be to simply requery the underlying form’s recordset directly, something like

Me.RecordSet.Requery

Or

Forms!YourFormName.Form.RecordSet.Requery

The beauty here is the screen data updates itself, but the form remains exact as is, the scrollbar doesn’t move, so it is completely transparent to the end-user.

MS Access – Persistent Connection in a Split Database

 

The Art of Database Development: Establishing a Persistent Connection

When it comes to database development, seasoned professionals understand that best practices dictate a clear separation between two essential components: the Back-End, where your data resides, and the Front-End, which encompasses all the interactive elements like queries, forms, reports, macros, and modules. However, one crucial aspect that many developers overlook is the significance of maintaining a persistent connection between the Front-End and Back-End.
 
Continue reading

MS Access – VBA – Export Database Objects to Another Database

I while back, I wanted to unsecure a database.  Instead of messing around with accounts….  I simply decided to export everything, all the database objects: tables, queries, forms, reports, macros, modules into a new unsecured database.  Now you can right-click on each object, one at a time, select export, browse to find the database, click ok, ok…   but this is simply a complete waste of time.

Don’t ask me why you can’t, using multiple selected objects, perform an export?!  this to me is the type of oversight made by MS’ development team, but this is another discussion altogether.

The good news is that we can easily accomplish a complete export using the power of VBA and a few very simple lines of code!

'---------------------------------------------------------------------------------------
' Procedure : ExpObj2ExtDb
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Export all the database object to another database
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sExtDb    : Fully qualified path and filename of the database to export the objects
'             to.
'
' Usage:
' ~~~~~~
' ExpObj2ExtDb "c:\databases\dbtest.accdb"
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2008-Sep-27                 Initial Release
'---------------------------------------------------------------------------------------
Public Sub ExpObj2ExtDb(sExtDb As String)
    On Error GoTo Error_Handler
    Dim qdf             As QueryDef
    Dim tdf             As TableDef
    Dim obj             As AccessObject

    ' Forms.
    For Each obj In CurrentProject.AllForms
        DoCmd.TransferDatabase acExport, "Microsoft Access", sExtDb, _
                               acForm, obj.Name, obj.Name, False
    Next obj

    ' Macros.
    For Each obj In CurrentProject.AllMacros
        DoCmd.TransferDatabase acExport, "Microsoft Access", sExtDb, _
                               acMacro, obj.Name, obj.Name, False
    Next obj

    ' Modules.
    For Each obj In CurrentProject.AllModules
        DoCmd.TransferDatabase acExport, "Microsoft Access", sExtDb, _
                               acModule, obj.Name, obj.Name, False
    Next obj

    ' Queries.
    For Each qdf In CurrentDb.QueryDefs
        If Left(qdf.Name, 1) <> "~" Then    'Ignore/Skip system generated queries
            DoCmd.TransferDatabase acExport, "Microsoft Access", sExtDb, _
                                   acQuery, qdf.Name, qdf.Name, False
        End If
    Next qdf

    ' Reports.
    For Each obj In CurrentProject.AllReports
        DoCmd.TransferDatabase acExport, "Microsoft Access", sExtDb, _
                               acReport, obj.Name, obj.Name, False
    Next obj

    ' Tables.
    For Each tdf In CurrentDb.TableDefs
        If Left(tdf.Name, 4) <> "MSys" Then    'Ignore/Skip system tables
            DoCmd.TransferDatabase acExport, "Microsoft Access", sExtDb, _
                                   acTable, tdf.Name, tdf.Name, False
        End If
    Next tdf

Error_Handler_Exit:
    On Error Resume Next
    Set qdf = Nothing
    Set tdf = Nothing
    Set obj = Nothing
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: ExpObj2ExtDb" & vbCrLf & _
           "Error Description: " & Err.Description, _
           vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub

Voilà, nothing to it (once you do it once).

Export Office 2007 QAT to Office 2010

I was recently migrating a client from an older laptop with Office 2007 to a new laptop with Office 2010 and wanted to even transfer their Quick Access Toolbars (QAT).

Exporting your Quick Access Toolbar from MS Office 2007

So the first issue was determining where MS Office stores such information.  In realitym this is very straight forward.  In MS Office 2007, each application create one or many *.QAT files to store any customization made to the quick access toolbar by the user and these files can be located in:

For Windows XP:
C:\Documents and Settings\%username%\Local Settings\Application Data\Microsoft\Office
%systemdrive%\Documents and Settings\%username%\Local Settings\Application Data\Microsoft\Office
%AppData%\Microsoft\Office

For Windows Vista and Windows 7
C:\Users\%username%\AppData\Local\Microsoft\Office
%systemdrive%\Users\%username%\AppData\Local\Microsoft\Office

Then simply copy and *.QAT files so you can migrate them to your MS Office 2010 installation.

Importing your Quick Access Toolbar into MS Office 2010

The process is once again very simple:

  1. Navigate to the appropriate folder (same as the exporting folder)
  2. Paste the QAT files
  3. Rename each file’s extension from *.QAT to *.officeUI

 The critical step is renaming the files properly!

That’s it, that’s all!

Windows Update KB2596856 / MS12-060 Breaks Microsoft Windows Common Control Library (MSCOMCTL.OCX)

On Tuesday, August 14, 2012, MS released a new update which in fact crippled any application which used the Microsoft Windows Common Control Library (MSCOMCTL.OCX)!  So anyone using any of the following Microsoft Windows Common Controls:

  •  Animation control
  • Button
  • Combo box
  • ComboBoxEx control
  • Date and time picker
  • Edit control
  • Flat scroll bar
  • Header control
  • Hot key control
  • Image list
  • IP address control
  • List box
  • List-view control
  • Month calendar control
  • Pager control
  • Progress bar
  • Property sheet
  • Rebar control
  • Rich edit control
  • Scroll bar
  • Static control
  • Status bar
  • SysLink control
  • Tab control
  • Task dialog
  • Toolbar
  • Tooltip
  • Trackbar
  • Tree-view control
  • Up-down control 

There have been numerous disccusions on the matter, amongst them:

And numerous proposed solutions, amongst them:

That said, the true solution, which partially worked for me (it resolved my computer’s problem and got me back up and running but a serious compatibility issue with all my clients still remains!  See below for more information) was finally release by MS (after the community had already done all the leg worked an figured it out on our own) and was posted at: MS12-060: Description of the security update for Office 2010: August 14, 2012.

All of this is very nice, but there remain 2 major issues:

  1. This solution relies on the end-user doing all the fixing, on every computer!  Why has MS not released a hot fix that would automatically have fixed this?!  MS screwed-ed big time and sadly has passed the puck on to everyone else, rather than addressing the issue.
  2. Furthermore, even if you fix your computer, your application will no longer work on any computer that hasn’t had this update applied!!!  Just a little problem if you ask me!  So in fact their solution does not truly resolve the problem entirely as their remains a major compatibility issue at the end of the day.