Microsoft Access Combo Box Search While Typing

If you start typing in a Microsoft Access combo box, it might not search as you type. I eventually figured out the trick to making the search work. The problem occurs when the combo box is based on a query. For the query to work, it must be a DISTINCT query. In other words, if you go to SQL View (select View SQL from the ribbon), and the query is:

SELECT tblCategory.pcCategoryId, tblCategory.strCategory
FROM tblCategory
ORDER BY tblCategory.strCategory;

Change it to:

SELECT DISTINCT tblCategory.pcCategoryId, tblCategory.strCategory
FROM tblCategory
ORDER BY tblCategory.strCategory;

After that the search while typing should work.

Displaying an Image in a Microsoft Access Image Control

If you have a column in a Microsoft Access table that has the name of an image that refers to a file on the disk, you can update an image control in either a form or report with the code below. Put this code into a standard VBA module that you create with Insert Module from the menu. This code assumes that all the images are in a subdirectory of the location of the database called "images" if there are relative paths to the image file.

Public Const strImageFolder = "images"

Public Sub DisplayImage(ctlImageControl As Control, strImagePath As Variant)
    On Error GoTo ErrorHandler
    
    If IsNull(strImagePath) Then
        ctlImageControl.Visible = False
    Else
        If InStr(1, strImagePath, "\") = 0 Then
            strImagePath = Application.CurrentProject.Path & "\" & strImageFolder & "\" & strImagePath
        End If
        ctlImageControl.Visible = True
        ctlImageControl.Picture = strImagePath
    End If
    Exit Sub
ErrorHandler:
    Select Case Err.Number
        Case 2114 'Doesn't support the format of the file
            ctlImageControl.Visible = False
        Case 2220 ' Can't find the picture.
            ctlImageControl.Visible = False
        Case Else  ' Some other error.
            MsgBox "Unexpected Error #" & Err.Number & " " & Err.Description, vbExclamation, "Unexpected Error"
    End Select
End Sub

To use this code in a form, if the control that contains the image name txtPicture and the image control is named imgPicture then add this code to the module for the form:

Private Sub Form_AfterUpdate()
    Call DisplayImage(Me!imgPicture, Me!txtPicture)
End Sub

Private Sub Form_Current()
    Call DisplayImage(Me!imgPicture, Me!txtPicture)
End Sub

Private Sub txtPicture_AfterUpdate()
    Call DisplayImage(Me!imgPicture, Me!txtPicture)
End Sub

To use it in a report, assuming there is a column in the table or query the report is based on called strPicture and an image control named imgPicture, add this code to the report:

Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer)
    Call DisplayImage(Me!imgPicture, Me!strPicture)
End Sub

Extracting Microsoft Access OLE Object Field Items

I created a Microsoft Access database for a small set of data (<1000 rows). Access was a perfect database for this particular problem, allowing easy input and good reporting, and the Access accdb database format allows easy installation on different computer that have Access. However, I made a mistake in storing bitmaps in an OLE object column. Access still has a limit of two gigabytes for its native database format. Bitmaps don't compress and quickly consume all of that limit. I had entered several hundred items before running into that limit. The two gigabyte limit was reasonable in the 1990s when a 1 gigabyte drive cost over $1000 (I have a receipt!), but is ridiculously small by today's standard.

The VBA code below works on the table tblExample. It extracts the bitmap from an OLE Object column (olePicture) and writes it to a file on the disk. It then updates another column (strPicture) with the name of the file it wrote. The filename is constructed by the name of the primary key field (ID) followed by .bmp, thus ID of 1 becomes 1.bmp in the same directory as the database.

An OLE Object field has a Package Header, an OLE header, the actual data of the bitmap, some optional other stuff, and an OLE footer. The problem is that the headers are variable length with sizes embedded into them, so the actual bitmap has to be located within the data before it can be extracted. So this code extracts the sizes and skips to the appropriate place and extracts the data. It uses a helper function that constructs a long from the first four bytes of an array of bytes (although it will break if a size is over 2^31 as it would try to convert an unsigned count to a signed count, which should never happen here).

After running this code successfully (use the Windows File Explorer to view the bitmaps), the OLE Object column can be deleted. Other VBA code will be necessary to display the picture in the external file, which is beyond the scope of what I want to show here. The code is not very fast as it writes the file one byte at a time, but it should be a one-time thing, at least for my purpose. It also probably has some boundary conditions related to some kinds of OLE objects that break it under some conditions, but it worked for what I needed.

Option Compare Database
Option Explicit

Public Sub ExtractImages()
    ' Need a reference to the Microsoft ActiveX Data Objects 6.1 Library
    Dim rst As ADODB.Recordset
    Dim varByte As Variant
    Dim i As Long
    Dim lngLength As Long
    Dim byteVal As Byte
    Dim strFileName As String
    Dim strFilePath As String
    
    Set rst = New ADODB.Recordset
    rst.Open "tblExample", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
    Do While Not rst.EOF
        If Not IsNull(rst.Fields.Item("olePicture").Value) Then
            ' Create the filename from the primary key ID field.
            strFileName = rst.Fields.Item("ID").Value & ".bmp"
            
            ' Fill strPicture with the filename
            rst.Fields.Item("strPicture").Value = strFileName
            rst.Update
            
            strFilePath = Application.CurrentProject.Path & "\" & strFileName
            If Dir(strFilePath) = "" Then
                ' Read the package header the package header, the second byte is the size
                varByte = rst.Fields.Item("olePicture").GetChunk(3)
                
                'Extract the offset to the start of the OLE header
                varByte = rst.Fields.Item("olePicture").GetChunk(varByte(2) + 5)
                
                'Get the first four bytes which holds the OLE size
                varByte = rst.Fields.Item("olePicture").GetChunk(4)
                
                ' Use to size to of the header to move to the end of the header
                varByte = rst.Fields.Item("olePicture").GetChunk(GetLong(varByte))
                
                ' Skip the next eight bytes
                varByte = rst.Fields.Item("olePicture").GetChunk(8)
                
                ' The next four bytes retrieves the size of the Bitmap
                varByte = rst.Fields.Item("olePicture").GetChunk(4)
                
                ' Turn those bytes into a length
                lngLength = GetLong(varByte)
                
                ' Get the bitmap
                varByte = rst.Fields.Item("olePicture").GetChunk(lngLength)
                
                ' Write the bitmap to the file
                Open strFilePath For Binary As #1
                For i = 0 To lngLength - 1
                    byteVal = varByte(i)
                    Put #1, , byteVal
                Next i
                Close #1
            End If
        End If
        rst.MoveNext
    Loop
    rst.Close
    Set rst = Nothing
    MsgBox "Done"
End Sub

Public Function GetLong(ByRef varByte As Variant) As Long
    ' Convert the first four bytes of varByte into a long
    Dim i As Long
    Dim lngResult As Long
    
    For i = 3 To 0 Step -1
        lngResult = lngResult * 256 + varByte(i)
    Next i
    GetLong = lngResult
End Function