MS Access Control Functions

Here is Control module I created to simplify selecting items in controls.  I have just copied and pasted this.  Don’t have time to add comments.  Feel free to post a comment if you have a question or send me an email.

Option Compare Database
Option Explicit

Const mcModuleName As String = "basControls"

Function Find_Item_In_Control(ByVal pRecord_ID As Long, ByVal ctl As Control) As Long
    On Error GoTo err_handler
    Dim ListIndex_FoundItem As Long
    Dim I As Long
    For I = 0 To ctl.ListCount - 1
        If ctl.Column(0, I) = CLng(pRecord_ID) Then
            ListIndex_FoundItem = I
        End If
    Next I
    Find_Item_In_Control = ListIndex_FoundItem
    'On Error Resume Next
    'On Error GoTo 0
    Exit Function

    Resume exit_Here
End Function

‘Call this code with this line.
’Select_Item_In_Control Me.txtSysText_ID, Me.lboText_Local, 0

Function Select_Item_In_Control(ByVal pRecord_ID As Long, ByVal ctl As Control, Optional pRecord_ID_Column As Long) As Long
    On Error GoTo err_handler
    'Last Edit: 15-Apr-2010 Mark Dobson
    'Function Assumes that the record id is in column 0 in control.
    Dim ListIndex_FoundItem As Long
    Dim I As Long
    For I = 0 To ctl.ListCount - 1
        If ctl.Column(pRecord_ID_Column, I) = CLng(pRecord_ID) Then
            ListIndex_FoundItem = I
        End If
    Next I
    Select_Item_In_Control = ListIndex_FoundItem
    ctl = ListIndex_FoundItem
    ctl.Selected(ListIndex_FoundItem) = True
    'On Error Resume Next
    'On Error GoTo 0
    Exit Function

    Resume exit_Here
End Function

Function Select_Next_Item_In_ListBox(pListIndex As Long, ctl As Control)
    On Error GoTo err_handler
    'Last Edit: 19-Apr-2010 Mark Dobson
    Dim ListIndex_FoundItem As Long
    Dim I As Long
    Dim ListCount As Long
    Dim ListItem As Long
    ListCount = ctl.ListCount - 1
    If pListIndex = 0 Then
        ListItem = pListIndex
        If ListCount > pListIndex Then
            ListItem = pListIndex
        ElseIf ListCount = pListIndex Then
            ListItem = pListIndex
        ElseIf ListCount < pListIndex Then
            ListItem = ListCount
        End If
    End If
    Select_Next_Item_In_ListBox = ListItem
    ctl = ListItem
    ctl.Selected(ListItem) = True
    'On Error Resume Next
    'On Error GoTo 0
    Exit Function

    Resume exit_Here
End Function

Function Control_Exists(frm As Form, ctlName As String)
    Dim ctl As Control
    For Each ctl In frm.Controls
        If ctl.Name = ctlName Then
            Control_Exists = True
        End If
    Next ctl
    Set ctl = Nothing
End Function

Function Control_RunCode(ctl As Control)

    'RunCode , System_Lookup, DataType
End Function

Function Control_Selected_Array(ctl As Control, sItems() As String, Optional Col As Integer = 1) As Long
    Const ProcName As String = "Control_Selected_Array()"
    On Error GoTo err_handler
    Dim intCurrentRow As Long
    Dim sSelectedItems As String
    Dim Selected_Count As Long
    If ctl.ItemsSelected.Count > 0 Then
        For intCurrentRow = 0 To ctl.ListCount - 1
            If ctl.Selected(intCurrentRow) Then
                If Selected_Count > 0 Then
                    sSelectedItems = sSelectedItems & ","
                End If
                sSelectedItems = sSelectedItems & ctl.Column(Col, intCurrentRow)
                Selected_Count = Selected_Count + 1
            End If
    End If
    If Selected_Count > 0 Then
        sItems() = Split(sSelectedItems, ",")
        Control_Selected_Array = Selected_Count
    End If
    Exit Function

    Control_Selected_Array = Null
    Resume exit_Here
End Function

Function Bind_Controls(clnControls As Object, Optional UnBind As Boolean)
    Dim ctl As Control
    For Each ctl In clnControls
        If ctl.ControlType = acComboBox Or ctl.ControlType = acTextBox Or ctl.ControlType = acCheckBox Then
            If Left(ctl.Name, 3) = "fld" Then
                If Not UnBind Then
                    ctl.ControlSource = Mid(ctl.Name, 4)
                    ctl.ControlSource = ""
                End If
            End If
        End If
    Next ctl
End Function

Development Strategies

Here is my development process and strategy.

Phase 1 - Design

1. Document requirements by functional delivery in a shopping list style. 

2. Create process flow diagrams as part of the design, seek agreement from Client.
    - The flows should demonstrate everything the software is going to do visually.
    - Refer to and update the process flows during development.

3. Outputs - Design Reports Visuals in Excel.

4. Inputs - Take care to get the database design right first time.

5. Get the client to agree that this is what they want.  This becomes the scope of the project.  Anything without a process flow is out of scope. Any new tables are out of scope etc.

Phase 2 - Development


1. Don’t take short cuts in coding.  Look for the shortest way to solve a problem.

2. Use a version table and store notes of work done.  Try to update for each task.  I have a Form to update the table, so that version numbers are automatic.

3. Write re-usable self documenting code. Prefer class modules and functions.  I use a separate module for each table or feature.

4. Use a standard code template style for Forms with Functions for
    - Load_Record or Refresh_View

Use A Code Library - Such as:

5. A standard options system which uses an .ini file.

6. Wrapper functions to manage the File System, SQL Server, Email, Excel, Messages, etc.

Save Time: - Tricks

7. Use Queries to store an SQL Template.  My code can just read the SQL from the querydef object and then modify a Where clause as required.

Use Text Completion Tool

8. I use Texter by Life Hacker.  It’s great, apart from the fact I cant get it to work on Windows 7 very well, its good on Windows XP.  I have created standard text for modules and coding sections.  I can just type a keyword and then Texter will replace that with the desired code.
Check it out:


9.  Develop the system with Testing in Mind from the start.  You have to be able to demonstrate that the software does what its supposed to in an easy to understand way.


10. Create the MS Access Application

Ping Host

Sample code to Ping a host computer to ensure its available before connecting to it.

Function PingHost(sHost) As Boolean
    Dim oPing As Object, oRetStatus As Object
    Set oPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
                ("select * from Win32_PingStatus where address = '" & sHost & "'")
    For Each oRetStatus In oPing
        If IsNull(oRetStatus.StatusCode) Or oRetStatus.StatusCode <> 0 Then
            PingHost = False
            PingHost = True
        End If

End Function


Close In Active Access App

The sample code here closes an Inactive MS Access 2007 application.

You can download a sample app from my Skydrive shared folder.

File Name:!295&parid=A32D42A8853C90C0!224

The code in my sample was adapted from a sample a few years ago by Peters Software.

Peter has released a newer version:

Create a Month on Month

How to quickly create a custom Month on Month Report

The User Question:


The report in question must contain:

details per deal per chosen month per salesperson in chosen firms

+ totals & count per salesperson and firm & chosen firms for chosen month

PLUS same totals and counts for the whole year incl. chosen month

PLUS totals for the firms from last year's database.

There are only few, light surplus data in the table, however details on not chosen months are not needed - only totals and counts. The total database for previous years are each less than 10 MB and this years database will supposedly not be any heavier.

How and where should I include the PLUS info?


You can achieve that with a 2 tables and 3 sub queries, a parent query and a form to drive it all.

Sub Queries: 1 for this year, 1 for last year and 1 for the selected Report.

The parent query is to join 3 sub queries.

I would create 2 supporting tables and a form.


1. tbl_Report_Run Table: To store the report run details - This allows reports to be run-run quickly


    • Run ID
    • Report Name
    • From Date
    • To Date
    • Report Month

(Field Names don’t have spaces in production)

I prefer not to use system names in code such as Month which is an Access system Name. Therefor I have used ReportMonth here which is also more descriptive.

2. tbl_Report_Firm Table: Store the Run ID and Firm IDs. - Used to filter the firms.


    • Run ID
    • Firm ID


Form: frm_Report_Builder

The form would have

    • A Tab Control with 2 Pages, 1 to define new reports and 1 to select a report to view
    • A Multi select List box
    • Report Name text box
    • From & To Date text boxes
    • Month to View Combo box
    • Save Button
    • A Run Button for Tab 2


1. Write code to Save the Report Options to the tbl_Report_Run table

2. Write code to Loop Selected Firms in the Multi Select List Box and insert them into the tbl_Report_Firm table.

To view a Report.

Select the Report from the Report List on your Form

(The Report Run ID is selected from that List Box)

  • Click Run
  • This will just Run the Parent Query


Sub Queries

1. Firms: Create a query to select a list of Firm ID's from your tbl_Report_Firm Table where the Run ID is coming from the Selected Run ID from your frmReport_Builder Open From.

2. Last Year query is generic.

Select the Fields you want and the groups and totals etc.

    • Add a Field to change the Deal Date to a Month value
      - In the where clause you need to add.
        IN(select ReportMonth from tbl_Report_Run where Run ID = [Forms!etc])
    • In the where clause for the Firm ID create another IN(Select Firm ID tbl_Report_Run where Run ID = [Forms!etc])  - Use the Builder tool to link to the Form and create the code.


3. Create a Query for this years data

Parent Query

  • Create a query. Add the Sub queries for Last Year and this year.
  • Create a Join on Firm ID
    - Selecting All the Firms from This Year and only the ones from Last year that match
  • Run the Query and its done.


You can now output that data to Excel for further analysis

Sample Application

I have created a sample MS Access application which demonstrates how this works.

Download if from my Skydrive Folder

This is also a movie which explains how it works in the folder.

Please feel free to contact me if you have any questions or feedback.



Windows Live Writer

the Windows Live Essentials are great.  Check them out and use them.  This post was created using Windows Live Writer.

Microsoft Access Software Development - In the cloud

Take your business to the cloud, with MS Access and the Microsoft SQL Azure cloud database.

You will have the best of everything. The rich user experience of MS Access, the power of SQL Server and the flexibility of the internet and the scalability of the cloud.

In really doesn't get any better.

VBA Software Development Support

Do you need help with VBA coding?

After reading so many forum posts from people who have important job roles and who are struggling with VBA coding to support the business they work for, it's clear there is a demand for small job coding support.

These types of problems are fun and challenging. So talk to us, we can supply functioning code which you can just paste into your application.

What's the point in you struggling to find samples or waiting for people to help you in a forum, we are specialist developers who can provide production quality code for you.

Email: provide a brief description of your problem and your contact details.


This function will fire a pass though query from MS Access and return a recordset if required.

Allows you to use a wrapper function to create your list of parameters before running this function.

Function Execute_SP(spName As String, Optional pParameters As String, Optional pReturnsRecords As Boolean) As Variant
    Const ProcName As String = "Execute_SP()"
    On Error GoTo err_handler
    'Pass a list of parameters to the stored procedure
    Dim dbs As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim sSQL As String
    Set dbs = CurrentDb
    Set qdf = dbs.CreateQueryDef("")

    sSQL = "[dbo].[" & spName & "] "
    If Len(pParameters) > 0 Then
        sSQL = sSQL & pParameters
    End If

    With qdf
        .Connect = fServer_ConnectString(fSQL_Active_Server_ID(), True)
        .ReturnsRecords = pReturnsRecords
        .sql = sSQL
        If .ReturnsRecords Then
            Set Execute_SP = .OpenRecordset(dbOpenDynaset, dbSeeChanges)
            .Execute dbSeeChanges
        End If
    End With
    On Error Resume Next
    Set dbs = Nothing
    Set qdf = Nothing
    On Error GoTo 0
    Exit Function
    HandleError Err, Err.Description, mcModuleName, ProcName
    Resume exit_Here
End Function

Extract Email Addresses from an Excel File into a Text File

Option Explicit

Function GetEmailAddresses()
    Dim s As String
    Dim I As Long
    Dim sh As Worksheet
    Dim filename As String
    Dim e As String
    Set sh = ActiveWorkbook.ActiveSheet
    For I = 1 To sh.UsedRange.Rows.Count + 1
        If InStr(sh.Cells(I, 1), "@") > 0 Then
            e = Trim(sh.Cells(I, 1).Value)
            e = Replace(e, ",", ";")
            If Not InStr(1, s, e) Then
                If Len(s) > 0 Then
                    s = s + ";"
                End If
                s = s + Trim(sh.Cells(I, 1).Value)
                Debug.Print I & " - " & e
            End If
        End If
    Next I
    Debug.Print Len(s)
    filename = ActiveWorkbook.Path & "\Excel-Email-List-" & Format(Now(), "yyyy-mmm-dd-hhmmss") & ".txt"
    WriteFile s, filename
End Function

Function WriteFile(s As String, FileNamePath As String)
    Dim FSO
    Dim TextStream
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set TextStream = FSO.CreateTextFile(FileNamePath, True)
    TextStream.Write s
    Call FSO.GetAbsolutePathName(FileNamePath)
    Call FSO.GetFileName(FileNamePath)
    Set FSO = Nothing
End Function