List the Installed PC Updates

Once again, building upon my previous post, Determine if an Update has been Installed or Not, I transformed my initial IsQuickFixNoInstalled() function into a more versatile function to list all the updates installed. One could easily use it to populate a listbox or output its results to a text file for easier review.

'---------------------------------------------------------------------------------------
' Procedure : EnumerateQuickFixes
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Enumerate the updates installed on the specified PC
' 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:
' ~~~~~~~~~~~~~~~~
' sHost     : Name, IP address of the computer to check
'             Omit this input variable if checking the local PC
'
' Usage:
' ~~~~~~
' ? EnumerateQuickFixes
' ? EnumerateQuickFixes("172.12.243.195")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2011-07-22                  Initial Release
'---------------------------------------------------------------------------------------
Public Function EnumerateQuickFixes(Optional sHost As String = ".") As Boolean
'only seems to report on Windows updates and nothing else (ie not office updates)
'Ref: https://msdn.microsoft.com/en-us/library/aa394391(v=vs.85).aspx
    On Error GoTo Error_Handler
    Dim oWMI                  As Object    'WMI object to query about the PC's OS
    Dim sWMIQuery             As String    'WMI Query
    Dim oQuickFixes           As Object    'List of QuickFixes matching our WMI Query
    Dim oQuickFix             As Object    'Individual QuickFix

    Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sHost & "\root\cimv2")
    sWMIQuery = "SELECT * " & _
                "FROM Win32_QuickFixEngineering"
    Set oQuickFixes = oWMI.ExecQuery(sWMIQuery)
    For Each oQuickFix In oQuickFixes
        Debug.Print oQuickFix.HotFixID, oQuickFix.Description, oQuickFix.Caption, oQuickFix.InstalledOn  ', oQuickFix.InstallDate, oQuickFix.Name, oQuickFix.Status
    Next

Error_Handler_Exit:
    On Error Resume Next
    Set oQuickFix = Nothing
    Set oQuickFixes = Nothing
    Set oWMI = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: EnumerateQuickFixes" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Do note that the function takes a couple seconds to return a value.

Determine if an Update has been Installed or Not

Continuing on my previous post, entitled VBA – Computer Uptime, about Access 2010 bug, I needed to find a way to identify whether or not certain updates had been installed on the server or not and did not have access to the admin console/control panel/etc.

Once again, I set out to create a function to ask the system and knew WMI could help! Below is the function I came up with:

'---------------------------------------------------------------------------------------
' Procedure : IsQuickFixNoInstalled
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Determine if an OS update has been installed or not on a PC
' 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:
' ~~~~~~~~~~~~~~~~
' sQuickFixNo:The Update/Hotfix/KB number - just the numeric part
' sHost     : Name, IP address of the computer to check
'             Omit this input variable if checking the local PC
'
' Usage:
' ~~~~~~
' IsQuickFixNoInstalled("2965300")
' IsQuickFixNoInstalled("2965300", "172.12.243.195")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2011-07-22                  Initial Release
'---------------------------------------------------------------------------------------
Public Function IsQuickFixNoInstalled(sQuickFixNo As String, Optional sHost As String = ".") As Boolean
'only seems to report on Windows updates and nothing else (ie not office updates)
'Ref: https://msdn.microsoft.com/en-us/library/aa394391(v=vs.85).aspx
    On Error GoTo Error_Handler
    Dim oWMI                  As Object    'WMI object to query about the PC's OS
    Dim sWMIQuery             As String     'WMI Query
    Dim oQuickFixes           As Object     'List of QuickFixes matching our WMI Query

    Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sHost & "\root\cimv2")
    sWMIQuery = "SELECT HotFixID " & _
                "FROM Win32_QuickFixEngineering " & _
                "WHERE ((HotFixID = 'Q" & sQuickFixNo & "') OR (HotFixID = 'KB" & sQuickFixNo & "'))"
    Set oQuickFixes = oWMI.ExecQuery(sWMIQuery)
    If oQuickFixes.count > 0 Then
        IsQuickFixNoInstalled = True    'It is installed
    Else
        IsQuickFixNoInstalled = False   'It is not installed
    End If

Error_Handler_Exit:
    On Error Resume Next
    Set oQuickFixes = Nothing
    Set oWMI = Nothing
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: IsQuickFixNoInstalled" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Do note that the function takes a couple seconds to return a value.

VBA – Computer Uptime

I’ve been dealing with an ongoing issue with Access 2010 where calculated controls do not display values.

When you start Microsoft Access 2010 on a computer that has not been restarted for a long time (for example, 24 days).

fields that are bound to expressions on forms may not be recalculated when the computer has not been restarted for a long time.

Taken from: https://support.microsoft.com/en-us/kb/2965300

Continue reading

Late Binding the FileDialog

I came across a nice reusable function, FSBrowse, to utilize the FileDialog to allow your users to select files/folders with ease.

That said, there was one major drawback, the fact that it necessitates a reference be set to Microsoft Office XX.X Object Library.  Now, the more experience I gain, the more I know that Early binding (requiring set references) is detrimental to any project!  So I set out to modify NeoPa’s nice function so it was Late Bound and thus didn’t require any reference libraries, making it completely portable into any project without any changes.

I did some digging and some testing and eventually came up with the following:

Updated 2022-10-10 to support multi-select file selection.
Both the code, usage examples and demo database have all been updated. So now you can easily do:

  • Single file selection
  • Multi file selection
  • Folder selection

Continue reading

Adding Attachments to an Access Database

Why You Should Avoid Using Attachment Data Type in Microsoft Access

The Attachment data type, introduced in Access 2007, allows users to insert files which get embedded directly into databases. However, this feature comes with significant drawbacks:

Database Bloat

Using Attachment fields causes rapid database size increase. Each attached file adds its full size to the database, quickly turning a small database into a large one.

Performance Impact

Large databases resulting from Attachment fields can negatively affect performance, slowing down initial load times, queries and overall operations.

Complex Interaction

Programmatically managing Attachment fields requires specialized code, making it challenging to insert, extract, or manipulate attached files.

 
Continue reading

Wscript.shell Specialfolders Not Behaving

I was recently doing some work in an old database trying to convert a very simple function which used Wscript.shell Specialfolders into a more versatile function that would accept a single input variable instead of a hardcoded value.

My original function was

Function m() As String
    Set WshShell = CreateObject("WScript.Shell")
    m = WshShell.SpecialFolders("Desktop")
End Function

Running it would return the path to the current user’s Desktop folder accurately.

C:\Users\MyUserName\Desktop

A very slight variation of the same function

Function mm() As String
    Set WshShell = CreateObject("WScript.Shell")
    sFldr = "Desktop"
    m = WshShell.SpecialFolders(sFldr)
End Function

would also return the path to the current user’s Desktop folder accurately.

C:\Users\MyUserName\Desktop

However, where things got weird was when I made another modification to use sFldr as an input variable and created the following function

Function n(sFldr As String) As String
    Set WshShell = CreateObject("WScript.Shell")
    n = WshShell.SpecialFolders(sFldr)
End Function

and ran it by calling by using the command n(“Desktop”) it would not return the current user’s Desktop folder, but rather the public desktop path???

C:\Users\Public\Desktop

So I started to do a little digging and came to find I was not the first person to encounter this issue. For instance, see:

Unexpected behavior of WScript.Shell SpecialFolders function

So I did a little more playing around with code and switched the input variable sFldr from String to Long

Function n(sFldr As Long) As String
    Set WSHShell = CreateObject("WScript.Shell")
    n = WSHShell.SpecialFolders(sFldr)
End Function

and performed a few iterations (1 to 16) and determined the following

1->ProgramData\Microsoft\Windows\Start Menu
2->ProgramData\Microsoft\Windows\Start Menu\Programs
3->ProgramData\Microsoft\Windows\Start Menu\Programs\Startup
4->User Desktop
5->User AppData\Roaming
6->User AppData\Roaming\Microsoft\Windows\Printer Shortcuts
7->User AppData\Roaming\Microsoft\Windows\Templates
8->Windows\Fonts
9->User AppData\Roaming\Microsoft\Windows\Network Shortcuts
10->User Desktop
11->User AppData\Roaming\Microsoft\Windows\Start Menu
12->User AppData\Roaming\Microsoft\Windows\SendTo
13->User AppData\Roaming\Microsoft\Windows\Recent
14->User AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup
15->User Favorites
16->User Documents
17->User AppData\Roaming\Microsoft\Windows\Start Menu\Programs

which is all odd to me. In the hardcoded version it expects a string value, but the last version takes a numeric value to get proper paths returned. The above (last function) has, by far, not been tested in any manner to ensure it is reliable, it is simply at this point an interesting observational fact.

What is a fact is that Wscript.shell Specialfolders does not appear to be reliable when the objWshSpecialFolders variable is not a hardcoded value! As such, I’d recommend using an alternate method to determine the paths of Windows Special folders like: Enumerating Special Folders which uses the CreateObject(“Shell.Application”).Application.Namespace() to get the values.

Update and Solution – 2016-09-28

Too stubborn for my own good, I couldn’t let this one go. So I kept playing around and testing… eventually I managed to get it to work. Below is the reusable function.

'---------------------------------------------------------------------------------------
' Procedure : GetWindowsSpecialFldrPath
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Return the full path for the specified Windows Special folder
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' vFldrName : The name of the folder to return the path of
'             Values can be: AllUsersDesktop, AllUsersStartMenu, AllUsersPrograms,
'                            AllUsersStartup, Desktop, Favorites, Fonts, MyDocuments,
'                            NetHood, PrintHood, Programs, Recent, SendTo, StartMenu,
'                            Startup, Templates
'
' Usage:
' ~~~~~~
' sPath = GetWindowsSpecialFldrPath("Desktop")
' sPath = GetWindowsSpecialFldrPath("MyDocuments")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' ********************************************************************************
******
' 1         2016-09-28              Initial Release
'---------------------------------------------------------------------------------------
Function GetWindowsSpecialFldrPath(vFldrName As Variant) As String
      '***Special Note: If vFldrName this is dimmed as a string it returns the wrong value ***
10        On Error GoTo Error_Handler
          Dim WshShell              As Object

20        If IsNull(vFldrName) = True Then GoTo Error_Handler_Exit
30        Set WshShell = CreateObject("WScript.Shell")
40        GetWindowsSpecialFldrPath = WshShell.SpecialFolders(vFldrName)

Error_Handler_Exit:
50        On Error Resume Next
60        If Not WshShell Is Nothing Then Set WshShell = Nothing
70        Exit Function

Error_Handler:
80        MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
                 "Error Number: " & Err.Number & vbCrLf & _
                 "Error Source: " & sModName & "\GetWindowsSpecialFldrPath" & vbCrLf & _
                 "Error Description: " & Err.Description & _
                 Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
                 , vbOKOnly + vbCritical, "An Error has Occurred!"
90        Resume Error_Handler_Exit
End Function

The entire issue is the way the input variable, vFldrName, is dimmed. If it is dimmed as a string it acts weird. Dim it as a variant and it works as expected. Since the documentations that I found simply mentions “The name of the special folder.” and does not specify the type to use and the examples provided were .SpecialFolders(“Desktop”) one would think it is a string, but apparently not.

Alternate Solution Update 2016-09-29

User daolix on UtterAccess recently answered my post on this subject and provided an interesting answer/solution:

If you want to use a string variable so you have to force a ByVal call at the “Special Folders”.
Your function n is just to expand only to a clip.

Function n(sFldr As String) As String
    Set WshShell = CreateObject("WScript.Shell")
    n = WshShell.SpecialFolders((sFldr))
End Function

If you pass on a “ByRef” variant, a variable which does not correspond to the data type “Variant”, a variant is created at the interface of the function, which contains a pointer to the passed variable as a value. A true “ByRef” transfer does not take place here, this is only “simulated” with the help of the variant, and corresponds rather to a “ByVal” transfer.
If you pass a string variable to this function, the system must dereference twice to get the content, because a string itself is only a pointer. And here probably the function “SpecialFolders” failed. Error from Microsoft? So wanted? No idea.

I tested his answer and it does work.

VBA – Determine the Installed OS

When troubleshooting various issues, one of the common thing one does is try to get some information about the PC itself.  Things like:

  • OS
  • MS Office

It can be difficult at time to get such information from users depending on their skill level and as such, a while back I had post in a forum a function which use WMI to get the OS name and version.  I took my old function and cleaned it up and provide it below should you wish to be able to easily determine your users’ OS easily.

'---------------------------------------------------------------------------------------
' Procedure : getOperatingSystem
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Return the active OS details
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Uses Late Binding, so none required
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sHost     : Name/IP Address of the PC to query assuming you have the rights to do so
'               optional, so by leaving it blank it will query the local computer
'
' Usage:
' ~~~~~~
' ? getOperatingSystem()  -> Microsoft Windows 7 Ultimate  6.1.7601 (64-bit)
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2012-09-27              Initial Release
' 2         2016-09-24              Code Cleanup and standardization
' 3         2018-08-30              Added OS bitness to returned value
'                                   Updated Copyright
'---------------------------------------------------------------------------------------
Public Function getOperatingSystem(Optional sHost As String = ".") As String
    'Win32_OperatingSystem -> https://msdn.microsoft.com/en-us/library/aa394239%28v=vs.85%29.aspx
    On Error GoTo Error_Handler
    Dim oWMI                  As Object    'WMI object to query about the PC's OS
    Dim oOSs                  As Object    'Collection of OSs
    Dim oOS                   As Object    'Individual OS

    Set oWMI = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & sHost & "\root\cimv2")
    Set oOSs = oWMI.ExecQuery("SELECT Caption, Version, OSArchitecture FROM Win32_OperatingSystem")

    For Each oOS In oOSs    'Enumerate each OS provided by WMI
        getOperatingSystem = getOperatingSystem & oOS.Caption & " " & oOS.Version & _
                             " (" & oOS.OSArchitecture & "), "
    Next
    getOperatingSystem = Left(getOperatingSystem, Len(getOperatingSystem) - 2)    'Remove the last ", "

Error_Handler_Exit:
    On Error Resume Next
    If Not oOS Is Nothing Then Set oOS = Nothing
    If Not oOSs Is Nothing Then Set oOSs = Nothing
    If Not oWMI Is Nothing Then Set oWMI = Nothing
    Exit Function

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

If you have some type of global error handler, this could be a valuable piece of information to include as part of the error reporting process.

Access Back-End Location – WAN, Online Server, OneDrive, DropBox, …

There have been a few recent threads, some of which I’ve been involved in:

in which people are inquiring about running a standard MS Access database over a WAN, an Online Server, Shared drives (OneDrive, DropBox, …) and the likes.
 

The Reality of MS Access Databases

Microsoft Access databases are only meant to be run through wired LANs.  This point cannot be over emphasized!  Access is not meant to be run on:

  • Wireless Networks (this means all wireless technologies whether it be a wireless networks, wifi, … and every other variation in between)
  • WANs
  • The Internet
  • Online Servers (which qualify as a WAN)
  • Azure File Share
  • Shared Drives like OneDrive, Google Drive, DropBox, et al. (which qualify as WANs)
  • SharePoint document Library

Regarding the last 2 items, I will refer you to the following quotes:

Continue reading

Convert MDBs into ACCDBs

In a recent MVP discussion someone asked about a tool to convert a series of mdb databases contained within a directory into accdb file format without having to do so one by one manually.

I had put together a primitive tool to do so for my own needs many moons ago and was more than happy to share it with them.

As such, I’ve decided to post a modified copy here in case it can serve others at large.

MDB to ACCDB ConverterYou specify the directory to process, whether or not to process sub-directories.  It will then make a listing of the mdb databases it finds.  It will also flag those in a state that it will not be able to convert (ldb present, or accdb already exists) giving you a chance to address such issues.  When you are ready to proceed, you simply click on the Convert Database(s) button and wait.

Continue reading

List Outlook Calendar Appointments

Once again, here is a simple procedure (based on a database I created many a moons ago) to extract a listing of appointments from your Outlook Calendar that I created to help someone in a forum. I thought the code could help others.

'---------------------------------------------------------------------------------------
' Procedure : GetFutureOutlookEvents
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Generate a listing of future appointments from your Outlook Calendar
' 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).
' Req'd Refs: None
'
' Usage:
' ~~~~~~
' Call GetFutureOutlookEvents
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2016-09-08              Initial Release
'---------------------------------------------------------------------------------------
Sub GetFutureOutlookEvents()
    Dim oOutlook              As Object
    Dim oNS                   As Object
    Dim oAppointments         As Object
    Dim oFilterAppointments   As Object
    Dim oAppointmentItem      As Object
    Dim bOutlookOpened        As Boolean
    Dim i                     As Long
    Const olFolderCalendar = 9

    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")    'Bind to existing instance of Outlook
    If Err.Number <> 0 Then    'Could not get instance of Outlook, so create a new one
        Err.Clear
        Set oOutlook = CreateObject("Outlook.Application")
        bOutlookOpened = False    'Outlook was not already running, we had to start it
    Else
        bOutlookOpened = True    'Outlook was already running
    End If
    On Error GoTo Error_Handler
    DoEvents

    Set oNS = oOutlook.GetNamespace("MAPI")
    Set oAppointments = oNS.GetDefaultFolder(olFolderCalendar)
    'Apply a filter so we don't waste our time going through old stuff if we don't need to.
    sFilter = "[Start] > '" & Date & "'"
    Set oFilterAppointments = oAppointments.Items.Restrict(sFilter)
    Debug.Print oFilterAppointments.Count & " appointments found."
    'Iterate through each appt in our calendar
    For Each oAppointmentItem In oFilterAppointments
        Debug.Print oAppointmentItem.Subject, oAppointmentItem.Start, oAppointmentItem.End
    Next

    If bOutlookOpened = False Then    'Since we started Outlook, we should close it now that we're done
        oOutlook.Quit 'There seems to be a delay in this action taking place, but does eventually take place
    End If

Error_Handler_Exit:
    On Error Resume Next
    Set oAppointmentItem = Nothing
    Set oFilterAppointments = Nothing
    Set oAppointments = Nothing
    Set oNS = Nothing
    Set oOutlook = Nothing
    Exit Sub

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

The above procedure uses a Items.Restrict Method to only list future appointments based on the current date. I did this just to demonstrate the ease with which you could extract specific details depending on your needs. Obviously, this can be modified, or eliminated depending on your needs.

This procedure also use Late Binding technics so no reference libraries are required, it is a simple plug & play procedure. Furthermore, it is not Access specific. This procedure could be run from Access, Word, Excel, or any other VBA platform.