Code Tip: Use Custom Cursors In MS Access

Using VBA in Access, apart from the Hand cursor for a Hyperlink control and using the Hourglass method of the DoCmd object, you can only use the MousePointer property of the Screen object to specify a mouse-pointer, with the cursor types limited to:

• Default Arrow
• Text Select (I-Beam)
• Vertical Resize (Size N, S)
• Horizontal Resize (Size E, W)
• Busy (Hourglass)

However, there are two API calls that allow you to use your own custom cursors or Windows system cursors in your Access applications. You can even use animated cursors.

Place the following code behind an Access form to see how the API calls work. A sample MDB is also available for download.

Option Compare Database
Option Explicit

' Declarations for API Functions
Private Declare Function LoadCursorFromFile Lib "user32" _
Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As Long
Private Declare Function SetClassLong Lib "user32" Alias_
"SetClassLongA" (ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function LoadCursor Lib "user32" Alias_
"LoadCursorA" (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long

' Declare Windows API Constants for Windows System cursors
Const GCW_HCURSOR = (-12)
Const IDC_APPSTARTING As Long = 32650&
Const IDC_ARROW As Long = 32512&
Const IDC_HAND As Long = 32649
Const IDC_HELP As Long = 32651
Const IDC_IBEAM As Long = 32513&
Const IDC_ICON As Long = 32641&
Const IDC_WAIT As Long = 32514&
Const IDC_UPARROW As Long = 32516&
Const IDC_SIZEWE As Long = 32644&
Const IDC_SIZENWSE As Long = 32642&
Const IDC_SIZENS As Long = 32645&
Const IDC_SIZENESW As Long = 32643&
Const IDC_SIZEALL As Long = 32646&
Const IDC_SIZE As Long = 32640&
Const IDC_NO As Long = 32648&

' Declare handles for cursor
Private Const GCL_HCURSOR = (-12)
Private hOldCursor As Long
Private hNewCursor As Long

Private Sub Form_Load()
'Load cursor
'Comment out code not required:
'Load system cursor
hNewCursor = LoadCursor(ByVal 0&, IDC_HAND)
'Load cursor from file
hNewCursor = LoadCursorFromFile(CurrentProject.Path & "\cool.cur")
'Load animated cursor from file
hNewCursor = LoadCursorFromFile(CurrentProject.Path & "\APPSTART.ani")
hOldCursor = SetClassLong(Me.hwnd, GCL_HCURSOR, hNewCursor)
End Sub

Private Sub Form_Unload(Cancel As Integer)
'Unload cursor
hOldCursor = SetClassLong(hwnd, GCL_HCURSOR, hOldCursor)
End Sub
 

Use ADO wildcards in the Access Query Design Grid

In MS Access 2000 or later, if you're using ADO, there is a way to use ADO wildcards in the Access query design grid. Instead of using the Like operator, use ALike, which also works in SQL statements used in VBA code.

All the Access Keyboard Shortcuts

70+ Keyboard shortcuts to move faster in Microsoft Access A download from TechRepublic.com.

A Better VBA Error-Handler

The undocumented VBA  constant Erl returns the line number in the procedure where an  error occurs, only if line numbers exist in the procedure:

Public Sub MyProc()
  10 On Error GoTo HandleError
  'A guaranteed error:
  20 Debug.Print 1 / 0

ExitHere:
  30 Exit Sub

HandleError:
  40 Debug.Print "Error No: " & Err.Number
  50 Debug.Print "Error Description: " & Err.Description
  60 Debug.Print "Error from Line No: " & Erl
  70 Resume ExitHere

End Sub

which returns:

Error No: 11
Error Description: Division by zero
Error from Line No: 20

in the Immediate Window.

So you now have an error-handler that returns the line number in which the error occurred!

Implementing this technique in your VBA applications, new AND existing, is easy using a great freeware Office VBA Editor add-in, MZ-Tools 3.0 VBA , which adds line numbering to a procedure in two mouse-clicks.

  Cool Tool Tips: A Better Control Tip Paradigm

In Access, the functionality of tools tips has not changed since they were introduced in Access95 ten years ago.

In a free sample Access2000 database Cool Tool Tips, which you can download, I have implemented a more functional and controllable paradigm, which also looks great.  If you have an application that is to any degree complex to use, Cool Tool Tips is an easily-implemented solution that avoids the need for a Help file, and keeps tips on the screen for however long they are needed by the user:

When a control with a tip gets the focus, the tip is read from the control's Tag property, and when the control loses the focus the tip is hidden. Clicking on the tip while it is displayed hides the tip.

A Tip's heading and text are separated by a "~" delimiter in the string assigned to a control's Tag property. The string is parsed by a generic public function in a module, called by another generic function behind the form.

Tip and Code Sample: Switching Printers from within your MS Access Application

Fellow Access develepor, Mark Plumpton, of customdata.co.nz, has kindly provided sample code for easily switching printers on the fly while printing Access reports, with code as simple as this...

   SaveDefaultPrinter
     DefaultPrinter = "HP Laserjet (A3)"
     DoCmd.OpenReport "rptTest", acViewNormal
   RestoreDefaultPrinter

Download these demo Access97/2000 databases, which include a class module that performs the function of listing and switching default printers.

The code is also an excellent example of how you can use classes in your MS Access applications.

 Create a 30 Day Demo of an MS Access Database

The object of the technique is to produce a fully protected 30 Day Demo of an Access database with the following features:

• Back-dating the system date does not overcome the 30 day trial limit
• Re-installation of the source file does not overcome the 30 day trial limit

with the caveat that no technique is hack-proof. This technique is aimed at protection against most users. Download the documentation and source code. 

Use Field Descriptions

Often overlooked is the easy way to document tables fields and automatically provide data entry guidance to users. In Table Design view, express the Description for each field as you would describe it to users making data entries. Access automatically displays the description in the Access status bar in a table's datasheet view and in forms.

Excel 2002/2003 lets you open and analyze an XML file as a native Excel file. You can use all of Excel's analysis tools, including pivot tables and pivot charts, with XML data. Use File Open, and select XML Files from the Files Of Type drop-down list. Navigate to the XML file you want to open, and click Open. Excel displays XML tags as column headings and lists the data in the rows below the appropriate column headings. For example, in an XML Orders file, every Orders element may have Ship Region as a child element. In the worksheet, Excel represents the child element as the column header /Orders/Ship Region/. Excel opens XML files as read-only files, so users can't make changes to the original file while analyzing it in Excel.

Add (All) to a LookUp Combobox

To add (All) as the first item in the droplist of an unbound combobox, replace the RowSource property with the following SQL string:

SELECT City FROM tblRegions
UNION SELECT "(All)" FROM tblRegions;

Access SQL Tip

Search for two or more single characters in a field. You can use the [ ] wildcard with the Like operator in your queries to search for two or more single characters in a field.

For example, suppose you want to find all customers with the following ZIP codes: 08052, 08053, or 08055. To use the [ ] wildcard, enter the following in your query's Criteria row under the ZIP Code field:

Like "0805[235]"

This expression searches for all field entries whose last character matches one of the characters specified between the brackets. Conversely, to search for all customers that don't live within these three ZIP code areas, place an exclamation point before the list, as shown below:

Like "0805[!235]"

The exclamation point inside the brackets stands for Not in the list. The query results will include all entries whose characters do not match any character in the list within the brackets.

You can combine the [ ] wildcard with any other wildcard character. For example, you can combine the * wildcard character with [ ] to search for any ZIP codes that begin with 0805, 0807, or 0808:

Like "080[578]*"

Give your applications a quick makeover

Globally replace MS Sans Serif font with Tahoma.

Overcome the limited color choices offered by the Format menu for the backcolor of cells in datasheets

Using VBA:

Private Sub Form_Open(Cancel As Integer)
      Me.DatasheetBackColor = 12910591 'a soft yellow
End Sub

A neat way to test both for Null or an empty string

Using the MS Access Nz function:

If Nz(Me.txtFaxNo,"") = "" Then Me.cmdSendFax.Enabled = True

MS Access Shortcut Keys for data entry:

[Shift][Enter] to save a record
[Ctrl][Alt][Spacebar] to re-instate the default value
[Spacebar] to toggle values in a check box or option
[Ctrl][;] to insert the current date
[Ctrl][Shift][;] to insert the current time
[Ctrl][+] to add a new record
[Ctrl][-] to delete the current record
[Esc] to undo a change to the current record

Private Sub txtMyName_KeyPress(KeyAscii As Integer)

If KeyAscii >= 97 And KeyAscii <= 122 Then
KeyAscii = KeyAscii - 32
End If

End Sub

Double Quotes Demystified

In string variables and when constructing SQL strings in VBA, using double-quotes can be confusing and frustrating. Try these approaches:

1. Create a global constant to represent double quotes, which makes code easier to read:

Public Const pubconQuotes = """"

Example: strSQL = "Instr(MyField," & pubconQuotes & " " & pubconQuotes & ")<>0"

2. Example: strSQL = "Instr(MyField," & chr(34) & " " & chr(34) & ")<>0"


Alternate line shading in MS Access Reports

1. Declare a constant in the Declarations of the Report's module:

Const vbLightGrey = 12632256

If Me.CurrentRecord Mod 2 = 0 Then
Me.Section(acDetail).BackColor = vbLightGrey
Else
Me.Section(acDetail).BackColor = vbWhite
End If

Keep MS Access Form Controls in Focus

It can sometimes be difficult to find the cursor on a form. To clarify which control has focus, you can configure the control to display a different background color when the user moves to it. For example, you can configure the current control to appear with a yellow background. Follow these steps:

Open the form in Design View, and select the first control.
Go to Format | Conditional Formatting.
Under Condition 1, select Field Has Focus.
Click the Fill/Back Color button, and select yellow.
Click OK.

Set this condition for each control the user will tab to; in particular, set the condition on all controls that display text, such as text boxes and combo boxes.

Compact & Repair Trick

In a database with a StartUp Form, the form will open after a Compact/Repair operation on the open .mdb. To avoid this annoyance during development, hold down the <Shift> key before clicking Compact and Repair (Access 2000 and Access 2002). In Access97, this only works for Compact Database.

Get the guid of a library reference from code

Sub AddReference()

    Dim refItem As Reference

    Set refItem = Access.References.AddFromFile _
    ("D:\Program Files\Common Files\Microsoft _
    Shared\DAO\dao360.dll")

End Sub

Since the guid is unique for every object library, for example, the guid of "Microsoft DAO 3.6 Object Library" is always {00025E01-0000-0000-C000-000000000046}, and you can obtain the guid of any object library using the above code. You can then use the .AddFromGUID method to add a reference to the object library without knowing the file path.

  Formatted MessageBox in Access 2000/2002

Function FormattedMsgBox( Prompt As String, _
Optional Buttons As VbMsgBoxStyle = vbOKOnly, _
Optional Title As String = vbNullString, _
Optional HelpFile As Variant, _
Optional Context As Variant) _
As VbMsgBoxResult

If IsMissing(HelpFile) Or IsMissing(Context) Then
    FormattedMsgBox = Eval("MsgBox(""" & Prompt & _
    """, " & Buttons & ", """ & Title & """)")
Else
    FormattedMsgBox = Eval("MsgBox(""" & Prompt & _
    """, " & Buttons & ", """ & Title & """, """ & _
    HelpFile & """, " & Context & ")")
End If

End Function

Prevent users from tabbing to the next record

Prevent users from tabbing to the next record in a form by setting the form's Cycle property to 'Current Record'.

Windows System Colors

Color ID No... Color Description

-2147483648 Scroll bar
-2147483647 Desktop
-2147483646 Active window title bar
-2147483645 Inactive window title bar
-2147483644 Menu bar
-2147483643 Window
-2147483642 Window frame
-2147483641 Menu Text
-2147483640 Window Text
-2147483639 Title bar text
-2147483638 Active window border
-2147483637 Inactive window border
-2147483636 Application background
-2147483635 Highlight
-2147483634 Highlight Text
-2147483633 3-D face
-2147483632 3-D shadow
-2147483631 Dimmed (disabled) text
-2147483630 Button Text
-2147483629 Inactive window title bar text
-2147483628 3-D highlight
-2147483627 3-D dark shadow
-2147483626 3-D light
-2147483625 ToolTip Text
-2147483624 ToolTip background
-2147483621 Active window title bar color2

Using Access 97/2000/2002 Help

Place your cursor in a keyword in a module and Hit <F>1 to open the Help file entry for that keyword. Press F2 to open the Object Browser references

Subform Shortcuts

<Tab> to move from the control immediately before the subform to the subform

<Ctrl>+<Tab> to move to the control on the main form that follows the subform *

<Ctrl>+<Shift>+<Tab> to return to the control that precedes the subform *

* If there isn't a control on the main form to move to the main form will move to the next or preceding record.

List all CommandBars in a Database

Private Sub ListMenuBars()
'Need a reference to Office Object Library

Dim cbar As CommandBar
Dim cbctl As CommandBarControl

    For Each cbar In CommandBars
        Debug.Print cbar.Name, cbar.NameLocal, cbar.Visible, cbar.Index
    Next

End Sub

Design View Shortcut

In the Access Database window, to open an object in Design view, hold down the <Ctrl> key and double-click on the object's icon.

TypeName function

The TypeName function returns a String that provides information about a variable.

Syntax: TypeName(varname)

The required varname argument is a Variant containing any variable except a variable of a user-defined type.

Public Sub CustomMessageBoxes()

Dim iResponse As Integer

MsgBox Prompt:="Abort/Retry/Ignore (Ignore Default)", Buttons:=vbAbortRetryIgnore + vbDefaultButton3
MsgBox Prompt:="Critical", Buttons:=vbCritical
MsgBox Prompt:="Exclamation", Buttons:=vbExclamation
MsgBox Prompt:="Information", Buttons:=vbInformation
MsgBox Prompt:="OK/Cancel", Buttons:=vbOKCancel
MsgBox Prompt:="Question", Buttons:=vbQuestion
MsgBox Prompt:="Retry/Cancel", Buttons:=vbRetryCancel
MsgBox Prompt:="Yes/No", Buttons:=vbYesNo
MsgBox Prompt:="Yes/No with Information", _
Buttons:=vbYesNo + vbInformation
MsgBox Prompt:="Yes/No with Critical and Help", _
Buttons:=vbYesNo + vbCritical + vbMsgBoxHelpButton

' Determine which button the user selects.
iResponse = MsgBox(Prompt:="Click Yes or No.", _
Buttons:=vbYesNo + vbCritical)
Select Case iResponse
   Case vbYes
      MsgBox Prompt:="You clicked Yes."
   Case vbNo
      MsgBox Prompt:="You clicked No."
End Select

End Sub

IIf Reloaded

For example:

• If evaluating falsepart results in a division by zero error, an error occurs even if the expression is True. In such cases, call a module-level function that uses the If... Then statement.
  
• Avoid complex calculations in one or both of the truepart and falsepart.
  

Standardise your Forms and Reports with AutoFormat

1. Design a form/report that uses your standard fonts, colors, borders, background settings, and control properties.
   
2. In Design view, from the Menubar select Format, AutoFormat... , and then in the AutoFormat Dialog click Customize...
   
3. Under Customize options in the Customize AutoFormat dialog box, select Create A New AutoFormat Based On The Form/Report and click OK. Enter a name for the standard style in the New Style Name dialog, and click OK. Click Close.
   
4. To apply the custom format to a form/report, open the form/report in Design view, select Format, AutoFormat... , then select the new format from the Form/Report AutoFormats list, and click OK.
   

Change the Default Position of Attached Labels

Access attaches a label to the left of a control by default.

To change the default position of a control's attached label you can set the left and top co-ordinates of the label using the control's Label X and Label Y properties. For example, to change the default so that the label appears to the right of a text box:

1. In Design view, double-click the form's Properties button to open the form's Properties window. In the Toolbox, click the Text Box button, to display the default Text Box properties in the Properties window. On the Format tab, change the default from -1 to 1in (or -3 to 3cm) for the Label X property.
   
2. You can also change the default position of the attached label so it is located above the text box, by setting the Label X property to 0 and the Label Y property to -0.25in (or -0.75cm).
   

Get the Name of the ActiveControl

The ActiveControl object does not have a Name property, so you need to use the Control object class:

Function GetActiveCtlName() As String
__Dim ctlCurrentControl As Control
__Set ctlCurrentControl = Screen.ActiveControl
__GetActiveCtlName = ctlCurrentControl.Name
End Function

Using the CurrentProject Object - Access 2000/2002

The CurrentProject object has several collections that contain all Access objects in the current database:

You can use these collections in code to accomplish various tasks. The following example prints the name of each open form in the AllForms collection.

Sub AllForms()
    Dim obj As AccessObject, dbs As Object
    Set dbs = Application.CurrentProject
    ' Search for open forms in the AllForms collection.
    For Each obj In dbs.AllForms
        If obj.IsLoaded = True Then
            ' Print name of obj.
            Debug.Print obj.Name
        End If
    Next obj
End Sub

Access Help provides extensive documentation on the CurrentProject object and many useful code examples.

No Data In Report?

Add this code to a Report's On No Data Event property:

Private Sub Report_NoData(Cancel As Integer)
___MsgBox "This report contains no data. Cancelling..."
___Cancel = True
End Sub

Global Keyboard Shortcuts

Menus
Show the shortcut menu	SHIFT+F10
Make the menu bar active	F10
Show the program icon menu (on the program title bar)	ALT+SPACEBAR
Select the next or previous command on the menu or submenu	DOWN or UP ARROW (with menu/submenu displayed)
Select the menu to the left or right; or, with a submenu visible, switch between the main menu and the submenu	LEFT or RIGHT ARROW
Select the first or last command on the menu or submenu	HOME or END
Close the visible menu and submenu at the same time	ALT
Close the submenu only	ESC
Toolbars
Make the menu bar active	F10
Select the next or previous toolbar	CTRL+TAB or CTRL+SHIFT+TAB
Select the next or previous button or menu on the toolbar (when a toolbar is active)	TAB or SHIFT+TAB
Open the menu(when a menu on a toolbar is selected)	ENTER
Perform the action assigned to a button	ENTER (when a button is selected)
Enter text in a text box	ENTER (when text box is selected)
Select an option from a drop-down list box or from a drop-down menu on a button	Arrow keys to move through options in the list or menu; ENTER to select the option you want (when a drop-down list box is selected)

Useful Code

Public Function RefreshLinks(strFilename As String) As Boolean
' Refresh table links to a backend database - strFilename (full path)
' Returns True if successful.

___Dim dbs As Database
___Dim tdf As TableDef

___' Loop through all tables in the database.
___Set dbs = CurrentDb
______For Each tdf In dbs.TableDefs
_________' If the table has a connect string, it's a linked table.
_________If Len(tdf.Connect) > 0 Then
____________tdf.Connect = ";DATABASE=" & strFilename
____________Err = 0
____________On Error Resume Next
____________tdf.RefreshLink ' Relink the table.
_______________ If Err <> 0 Then
__________________RefreshLinks = False
__________________Exit Function
_______________ End If
_________End If
______Next tdf

___RefreshLinks = True ' Relinking complete.

End Function

---

Function ZoomBox()

___Screen.ActiveControl.SetFocus
___RunCommand acCmdZoomBox

End Function

---

Function IsLoaded(ByVal strFormName As String) As Integer
' Returns True ifstr FormName is open in Form or Datasheet view

___Const conObjStateClosed = 0
___Const conDesignView = 0

___If SysCmd(acSysCmdGetObjectState, acForm, strFormName) <> ______conObjStateClosed Then
_________If Forms(strFormName).CurrentView <> conDesignView Then
____________IsLoaded = True
_________End If
___End If

End Function

SysCmd - A Handy Function

The SysCmd function is very useful and versatile. Look up SysCmd in the Access Help file for pointers on its use.

I recently used a feature of the function to quickly check if a nominated form was open, rather than iterate through the Forms collection. The code is set out below.

I used the following syntax:
ObjectState = SysCmd(action[, objecttype][, objectname]),
where action, is an intrinsic Access constant for a designated action.

Calling the SysCmd function with the acSysCmdGetObjectState action argument and the objecttype and objectname arguments returns the state of the specified database object. An object can be in one of four possible states: not open or non-existent, open, new, or changed but not saved.

Note If the object is either not open or doesn't exist, the SysCmd function returns a value of zero.

Public Function fnTestStartupFormLoaded() As Boolean
Dim intObjType As Integer
Dim strObjName As String
Dim intObjState As Integer

intObjType = acForm
strObjName = "frmStartUp"
intObjState = SysCmd(acSysCmdGetObjectState, intObjType, strObjName)

If intObjState <> 0 Then 'StartUpForm is loaded
   fnTestStartupFormLoaded = True
Else 'StartUpForm is not loaded
   fnTestStartupFormLoaded = False
   MsgBox "This application is not licensed for this machine." & vbCrLf _
   & vbCr & "Contact " & "the Vendor.", _
   vbCritical + vbOKOnly + vbDefaultButton1, "© MDE Copy Protector"
   Application.CloseCurrentDatabase
End If

Exit Function

End Function

A Fool-proof Way to Add a Library Reference

Those of you who develop Access add-ins or library databases, know that adding a reference to the addin or library database to the user .mdb (i.e. the CurrentDb)can be tricky, as the library file may not be where it is expected to be.

I use the following function, which is called each time the library file is loaded and uses the Name property of the CodeDb (being the library file opened by code in the CurrentDb) function to return the full path of the library file:

Private Function aad_AddLibraryReference() As Boolean
On Error GoTo AddLibraryReferenceError

Dim aad_refBuilderLibrary As Reference

Set aad_refBuilderLibrary = References.AddFromFile(CodeDb.Name)

aad_AddLibraryReference = True

Exit Function

AddLibraryReferenceError:

If Err = 32813 Then 'Reference already exists
   Resume Next
Else
   MsgBox "Add LibraryDB Reference Error" & Err & ". " & Err.Description  
   aad_AddLibraryReference = False
   Exit Function
End If

End Function

The Forms Container

Create a new module in Northwinds .mdb, insert the folllowing code (adapted from one of my addins), and run the function, which takes less than a second to do its work:

Public Function aad_fnLoadFormsList()
On Error GoTo LoadFormsListError
              
    Dim aad_db As DAO.Database
    Dim aad_con As Container
    Dim aad_edoc As Document
              
    Set aad_db = CurrentDb()
    Set aad_con = aad_db.Containers!Forms
   
    For Each aad_edoc In aad_con.Documents
        If Left$(aad_edoc.Name, 1) <> "~" Then
            Dim aad_stObjectName As String
            aad_stObjectName = aad_edoc.Name
            Debug.Print aad_stObjectName
                Dim aad_frm As Form
                Dim aad_frmCtl As Control
                Dim aad_stControlList As String
                Dim aad_intIndex As Integer
                DoCmd.OpenForm aad_stObjectName _
                ', acDesign, , , , acHidden
                Set aad_frm = Forms(aad_stObjectName)
                    For aad_intIndex = 0 To aad_frm.Controls.Count - 1
                        Set aad_frmCtl = aad_frm(aad_intIndex)
                        If TypeOf aad_frmCtl Is ComboBox Or _
                        TypeOf aad_frmCtl Is ListBox Then
                            aad_stControlList = vbTab & "Control Name: " _
                        & aad_frmCtl.Name & "; Control Source: " _
                        & aad_frmCtl.ControlSource
                            Debug.Print aad_stControlList
                        End If
                    Next aad_intIndex
                DoCmd.close acForm, aad_stObjectName, acSaveNo
        End If
    Next aad_edoc
           
    aad_fnLoadFormsList = True
   
Exit Function

LoadFormsListError:

aad_fnLoadFormsList = False
MsgBox "Load Forms Error " & Err & ". " & Err.Description
Exit Function

End Function

Use the Distribute Setting

You can evenly distribute text within  a control by setting the TextAlign property to Distribute.

Use Office XP Dialogs

Access2002 Only

Office XP has it own File Dialogs. You no longer need use API calls or the CommonDialog .ocx.

Private Sub OpenFileDialog()
___Application.FileDialog(msoFileDialogOpen).Show
End Sub

This MS KB Article will get you started: How to Display and Use the FileDialog in Access 2002

Automatically Open a ComboBox

Private Sub cboExample_GotFocus()
___Me.cboExample.Dropdown
End Sub

Size To Fit Forms

Easily size your popup forms in Access by opening the form in FormView. The form should not be maximized and the form's BorderStyle should be Resizable. Then select Window, Size To Form from the MenuBar. Save the form by pressing Ctl+s.  You can now reset the BorderStyle in need.

Compact a Database Using Jet

Function CompactDb(strSourceDB As String, strDestDB As String)

Dim jetEngine As JRO.JetEngine
Dim strSourceConnect As String
Dim strDestConnect As String

' Build connection strings for SourceConnection
' and DestConnection arguments
strSourceConnect = "Data Source=" & strSourceDB
strDestConnect = "Data Source=" & strDestDB

Set jetEngine = New JRO.JetEngine

jetEngine.CompactDatabase strSourceConnect, strDestConnect

Set jetEngine = Nothing

End Function

CommandBar Trick

This is something I recently discovered. You can add built-in Access menu commands to custom commandbars.

Normally, in the Customize dialog, if you drag a built-in menu to a custom commandbar and make changes to any if its submenu items, the changes also occur in the built-in commandbar that the menu-item comes from. To fix this, you need to reset the built-in commandbar and lose the changes in the custom commandbar.

The workaround is, after dragging the menu item to your custom commandbar:

• Drag each submenu item onto the custom commandbar.
  

• Remove the depleted menu item from the the custom commandbar.

You can now use/customize each native submenu item without affecting the native commandbar.

Resize Form Controls

You can use the InsideHeight and InsideWidth properties of an Access form to dynamically resize controls at run-time. A form's Resize event as well as firing when a user resizes a form, also fires when a form is loaded.

For example, this code will resize a sub-form within a resized form:

Private Sub Form_Resize()
On Error GoTo ResizeError

    'Turn off screen redraw  
    Application.Echo False
        Me!subfrmTest.Height = Me.InsideHeight -30      
        Me!subfrmTest.Width = Me.InsideWidth - 30
    'Turn screen redraw back on
    Application.Echo False

Exit Sub
ResizeError:

    ' NB: Turn screen redraw back on if an error occurs!
    On Error GoTo 0
    Exit Sub
       
End Sub

What's in the .ldb file

For every Access database opened for shared use, an .ldb file is created to store computer and login names, and to place extended byte range locks. The .ldb file always has the same name as the opened .mdb and is located in the same folder.

The Jet database engine uses .ldb file information to prevent users from writing data to pages that other users have locked, and to determine who has other pages locked. If Jet detects a lock conflict with another user, it reads the .ldb file to get the computer and login name of the user who has the file or record locked.

In most lock conflict situations, Access raise a generic Write conflict message that allows you to save the record, copy it to the Clipboard, or drop the changes you made. In some circumstances, you may receive the following error message:

1. In the form create a TextBox that sits exactly over the ComboBox

2. Set the ComboBox's Visible property to False

3. The TextBox is Visible and holds a value according to needs of the application: it may be a bound control or, as in the sample code below, unbound with the value assigned on the Form_Load event.

4. Clicking on the TextBox hides it and displays the ComboBox. After the user has updated the ComboBox, the value is assigned to the TextBox and the ComboBox hidden again.

Private Sub Form_Load()
    Me!txtHideShow.SetFocus
    Me!txtHideShow.Text = "Test"
End Sub

Private Sub txtHideShow_Click()
    Me!cmbHideShow.Value = Me.txtHideShow.Value
    Me!cmbHideShow.Visible = True
    Me!cmbHideShow.SetFocus
    Me!txtHideShow.Visible = False
End Sub

Private Sub cmbHideShow_AfterUpdate()
    Me!txtHideShow.Value = Me.cmbHideShow
    Me!txtHideShow.Visible = True
    Me!txtHideShow.SetFocus
    Me!cmbHideShow.Visible = False
End Sub

Get the UNC Network Path

Use the IIf Function for True-False Comparisons in Queries

The IIf function takes the following format:

IIf(Expression, TruePart, FalsePart)

Where:

• Expression is the true-false comparison that you want to make

• TruePart is the value returned if the comparison evaluates to True.

• FalsePart is the value returned if the comparison evaluates to False.

For example, a field alias value can be set as follows in the field value of a column in the Access query by design grid:

Grade: IIf([Score] < 50, "Fail", "Pass")

Quick & Easy way to check if a Table Exists

Private Function CheckIfTableExists() As Boolean
' Returns True if table exists.
   
    Dim db As DAO.Database
    Dim rst As DAO.Recordset
   
    Set db = CurrentDb

   ' Try to open table to see if it exists.
    On Error Resume Next
    Set rst = db.OpenRecordset("uztblErrorLog")

    ' If there's no error, ie. table exists, returns True.
    If Err = 0 Then
        CheckIfTableExists = True
    Else
        CheckIfTableExists = False
    End If
   
End Function

This approach can be extended to other Access objects.

Neat way to make or distribute Registry Entries/Changes

For example, the following represents a Registry entry that sets IE as an off-line browser:

REGEDIT4
[HKEY_USERS\,DEFAULT\Software\Microsoft\Windows\CurrentVersion\Internet Settings]
"GlobalUserOffline"=1

A file association in Windows allows users to double-click a .reg file and then confirm the action, and merge the contents of the file into the local registry.  So, for example, you would save the above entry in  Notepad as a .reg file, and then double-click the file in Windows Explorer to update the Registry.

Caution: Back up the registry before making any changes.

Handy User Keyboard Shortcut

To re-enter a default value in a field: [Ctrl][Alt][Spacebar].

Create a Table in Code

It is tricky creating a table in code, as some field properties are not in the default collection, for example, the Format property, and have to be created by the developer. The following procedure creates a new table and demonstrates how to add a field property if it does not exist:

Private Sub CreateLogTable()
On Error GoTo Err_CreateLogTable
 
    Dim db As DAO.Database
    Dim tdfLog As TableDef
    Dim idxLog As Index
    Dim idxLogID As Field
    Dim obj As Object
    Dim prp As Property
   
    Const conPropNotFound As Integer = 3270
   
    Dim strPathName As String
    Dim strTableName As String
    Dim strTimeFieldName As String
 
'   Open the database
    'strPathName = "database.mdb"
    'Set db = OpenDatabase(strPathName)
    Set db = CurrentDb
   
    strTableName = "tblLog"
   
'   Create the table
    Set tdfLog = db.CreateTableDef(strTableName)
   
'   Create the index field
    Set idxLog = tdfLog.CreateIndex("PrimaryIndex")
    With idxLog
        .Fields.Append .CreateField("LogID", dbLong)
        .Primary = True
        .Required = True
    End With
   
    tdfLog.Indexes.Append idxLog
    tdfLog.Indexes.Refresh
   
'   Create fields
    With tdfLog
        .Fields.Append .CreateField("LogID", dbLong)
        .Fields("LogID").Attributes = .Attributes Or dbAutoIncrField
        .Fields.Append .CreateField("LogDate", dbDate)
        .Fields.Append .CreateField("LogTime", dbDate)
        .Fields.Append .CreateField("LogFacility", dbText, 50)
        .Fields.Append .CreateField("LogName", dbText, 50)
        .Fields.Append .CreateField("LogText", dbText, 255)
        .Fields.Append .CreateField("LogReported", dbText, 255)
        .Fields.Append .CreateField("LogOutcome", dbText, 255)
    End With
   
    db.TableDefs.Append tdfLog
    db.TableDefs.Refresh
   
    With tdfLog
        strTimeFieldName = "LogDate"
        Set obj = db.TableDefs(strTableName).Fields("LogDate")
        .Fields("LogDate").Properties("Format").Value = "Short Date"
        strTimeFieldName = "LogTime"
        Set obj = db.TableDefs(strTableName).Fields("LogTime")
        .Fields("LogTime").Properties("Format").Value = "Medium Time"
    End With
   
    dbRMS.TableDefs.Refresh
 
    Set obj = Nothing
    db.Close
 
Exit_CreateLogTable:
 
    Exit Sub
   
Err_CreateLogTable:
 
     If Err = conPropNotFound Then
        ' Create property, denote type, and set initial value
       
        Dim strProperty As String
        Dim strTimeFormat As String
       
        strProperty = "Format"
        If strTimeFieldName = "LogDate" Then
            strTimeFormat = "Short Date"
        Else
            strTimeFormat = "Medium Time"
        End If
       
        Set prp = obj.CreateProperty(strProperty, dbText, _
            strTimeFormat)
       
        ' Append Property object to Properties collection
        obj.Properties.Append prp
        obj.Properties.Refresh
       
        Resume Next
       
     Else
    
        MsgBox Err.Description, vbCritical, _
            "RMS Update Server (Create tblLog)"
        Resume Exit_CreateLogTable
       
     End If
 
End Sub

Paste Controls Where You Want!

Arithmetic and Logical Operators

Arithmetic and logical operators are evaluated in the following order of precedence:

Arithmetic	Comparison	Logical
Exponentiation (^)	Equality (=)	Not
Negation (–)	Inequality (<>)	And
Multiplication and division (*, /)	Less than (<)	Or
Integer division (\)	Greater than (>)	Xor
Modulus arithmetic (Mod)	Less than or equal to (<=)	Eqv
Addition and subtraction (+, –)	Greater than or equal to (>=)	Imp
String concatenation (&)	Like
	Is

Custom Text and Memo formats

Create custom text and memo formats by using the following symbols as the Format property of fields or controls:

@  Text character (either a character or a space) is required
&  Text character is not required
<   Force all characters to lowercase
>   Force all characters to uppercase

Other Custom formats

You can use the following symbols in custom formats for any datatype:

Symbol     Meaning

(space)    Display spaces as literal characters.

"ABC"      Display anything inside quotation marks as literal characters.

!              Force left alignment instead of right alignment.

*             Fill available space with the next character.

\             Display the next character as a literal character. You can
              also display literal characters by placing quotation marks
              around them.

[color]    Display the formatted data in the color specified between the
              brackets. Available colors: Black, Blue, Green, Cyan, Red,
              Magenta, Yellow, White.

NB: When you have defined an input mask and set the Format property for the same datatype, the Format property takes precedence when data is displayed and the input mask is ignored.

Input Mask Characters

You can define an input mask by using the following characters:

Character    Description

0                  Digit  (0 to 9, entry required, plus [+] and minus [–] signs not allowed)

9                  Digit or space (entry not required, plus and minus signs not allowed)

#                  Digit or space (entry not required; spaces are displayed
                    as blanks while in Edit mode, but blanks are removed
                    when data is saved; plus and minus signs allowed)

L                  Letter (A to Z, entry required)

?                  Letter (A to Z, entry optional)

A                  Letter or digit (entry required)

a                  Letter or digit (entry optional)

&                  Any character or a space (entry required)

C                  Any character or a space (entry optional)

.  ,  :  ;  -  /     Decimal placeholder and thousand, date, and time
                    separators. (The actual character used depends on the
                    settings in the Regional Settings Properties dialog box in
                    Windows Control Panel)

<                  Causes all characters to be converted to lowercase

>                  Causes all characters to be converted to uppercase

!                   Causes the input mask to display from right to left, rather
                    than from left to right. Characters typed into the mask
                    always fill it from left to right. You can include the
                    exclamation point anywhere in the input mask.

\                  Causes the character that follows to be displayed as a
                    literal character (for example, \A is displayed as just A)

Search for "InputMask Property" in Access Help for more information.

Save the Trees: Use Multi-Column Reports

To create a multi-column report:

1. In Report Design View, select <File>, <Page Setup...>  from the Menubar
2. Select the Columns tab in the Page Setup dialog
3. Enter the number of columns
4. Optionally, set the row and column spacing properties
   
5. Enter the width of each column
6. Select  the Column Layout, and click OK.
   

Find Installed Versions of Access

The following code finds which currently MS supported versions of Access
(ie. 97/2000/2002), if any, are installled using the Word.Application object. The code can be used in any Office application or a VB executable.

Public Function OfficeDir(OffVer As String) As String
On Error GoTo ErrorTrap
   
   Dim objWord As Object
 
   Set objWord = CreateObject("Word.Application")
  
   Select Case OffVer
        Case "acc97"
            OfficeDir = objWord.System.PrivateProfileString("", _
            "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\8.0", _
              "BinDirPath") & "\msaccess.exe"
              'Debug.Print OfficeDir
        Case "acc2k"
            OfficeDir = objWord.System.PrivateProfileString("", _
          "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\9.0\Access\InstallRoot", _
              "Path") & "msaccess.exe"
              Debug.Print OfficeDir
        Case "accxp"
            OfficeDir = objWord.System.PrivateProfileString("", _
            "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office\10.0\Access\InstallRoot", _
              "Path") & "msaccess.exe"
              Debug.Print OfficeDir             
        Case Else
   End Select
  
   objWord.quit
   Set objWord = Nothing
 
Exit Function
ErrorTrap:
 
    objWord.Close
    Set objWord = Nothing
    MsgBox "Error " & Err & ". " & Err.Description & ".", vbCritical
    Exit Function
  
End Function

Create a Default Control

Check for Run Time Access

Function IsRunTime() As Boolean

Dim varReturn As Variant

    'Returns True (-1) if a run-time version of Access is running
    varReturn = SysCmd(acSysCmdRuntime)

    IsRunTime = varReturn

End Function

VBA Tips

Use Early Binding
When using object variables, wherever possible, declare the actual type of object instead of the generic Object variable to take advantage of the performance gains provided by early binding.

For example, Dim frm as Form instead of Dim frm As Object.

Use For Each... Next
When going through object collections, using For Each.. Next is much faster than using For... Next.

Using For Each.. Next, VBA needs to locate the address of the object variable only once, at the beginning of the loop, while For... Next de-references the object variable in the body of the loop on each iteration.

Use the Nz function to convert null to zero

In this example from the Access97 Help file, the NZ function converts a null value to zero, and the optional argument provides the string to be returned if varFreight is Null:

___varResult = Nz(varFreight, "No Freight Charge")

Search for Nz Function in Access Help for more information.

Get the Description for an Error Number

Use the AccessError method of the Application. object to return the descriptive string associated with an Access or DAO error:

___strstrErrorString = AccessError(lngError)

Dialog Shortcuts

Select a folder in the Open or Save As dialog box (File menu) (to select the folder list; arrow keys to select a folder)	ALT+0
Choose toolbar button in Open or Save As dialog box (File menu)	ALT+ number 1 is the leftmoist, 2 the next, and so on
Update files visible in the Open or Save As dialog box (File menu)	F5
Switch to next tab	CTL+TAB or CTL+PageDown
Switch to the previous tab	CTL+SHIFT +TAB or CTL+PageUp
Perform the action assigned to the default button	ENTER

Find Out if a Windows Application is Open

Option Compare Database
Option Explicit

'Use the API function FindWindow to determine whether an application is already running.
'Useful for OLE automation.
Declare Function FindWindow Lib "user32" Alias " FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

'Custom Declare statement that uses the FindWindow API call
'to find a window of the specified class.
'Pass a long NULL pointer for the window name.
Declare Function FindWindowByClass Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As Long) As Long

'Class names for some common applications:
'Access: OMain
'Excel: XLMAIN
'Word: OpusApp
'PowerPoint: PP97FrameClass
'Visual Basic: ThunderForm
'Binder: BinderFrame
'Visio: VisioA

Dim mblnRetVal As Boolean

'Example: find Word.
Public Function fnFindMSWord() As Integer

___Dim lngRetVal As Long
___Dim strMSG As String

___lngRetVal = FindWindowByClass("OpusApp", 0&)
___If lngRetVal <> 0 Then ' Word already open
______fnFindMSWord = True
___Else ' Word not open
______fnFindMSWord = False
End If

End Function

Determine the Caption of an Attached Label in Code

Use this simple VBA code to find the caption of a label attached to a control on a form or report:

Dim ctl As Control
Set ctl = Me.txtOrderID
Debug.Print ctl.Controls.Item(0).Caption

An Easy Way to Register a .dll Using Regsvr32.exe

Open two Windows Explorer windows - one window displaying the .dll and the other Regsvr32.exe. Now drag Regsvr32.exe over the .dll, and presto the .dll is registered!

Keyboard Shortcuts for Running and Debugging Code

To display the Debug window CTL+G To run a parameterless subprocedure containing the insertion point, from the Module window F5 To switch between the upper and lower panes F6 To step into a procedure (single step) F8 To step over a procedure SHIFT+F8 To step out of a procedure CTL+SHIFT+F8 To run code to the current insertion point and halt execution CTL+F8 To create an instant watch for a selected expression SHIFT+F9 To toggle a breakpoint at the selected line F9 To clear all breakpoints CTL+SHIFT+F9 To set the next statement CTL+F9 To continue the execution of code or a macro F5 To halt execution of code or macro CTL+BREAK To reset execution of code or macro F5 To reset execution of code or macro SHIFT+F5 To toggle between breaking and not breaking on unhandled errors and then step to the next statement ALT+F5 To toggle between breaking and not breaking in class modules and then continue execution ALT+F8

Run A Word MailMerge from Access

Copy and paste into a new Access module:

Option Compare Database
Option Explicit

Function MergeIt(stFilePath As String, stQuery As String)
Paramaters:
stFilePath As String - Full path to merge letter template
stQuery As String - SQL String for merge fields data from the CurrentDB

Dim stDBName As String
Dim objWord As Word.Document
Dim stSQL As String

stSQL = "Select * from " & stQuery & ""
stQuery = "QUERY " & stQuery

stDBName = CurrentDb.Name

Set objWord = GetObject(stFilePath, "Word.Document")

' Make Word visible.
objWord.Application.Visible = True

' Set the mail merge data source as the Northwind database
objWord.MailMerge.OpenDataSource _
Name:=stDBName, _
LinkToSource:=True, _
Connection:=stQuery, _
SQLStatement:=stSQL

' Execute the mail merge.
objWord.MailMerge.Execute

End Function

Effective Access Security

To effectively secure an Access database you MUST demote the Admin user from the Admins group. Otherwise your database will not be secure, as Admin cannot be removed from the Users group, and anyone using the retail system.mdw logs on automatically as Admin.

Securing An Access Database

1. Use the Access Workgroup Administrator (AWA), wrkgadm.exe, to create a new workgroup (.mdw) file.

2. Join the new workgroup using AWA.

3. Open Access and the database to be secured.

4. Using Tools, Security, User and Group Accounts..., in the User and Group Accounts dialog:

        4.1 Create a password for Admin user.

        4.2 Create a new user account. This account will be the new
        database owner account. In sample.mdw, this owner account
        is called DBOwner. Add "DBOwner" to all groups, including the
        critical Admins group.

5. Close and re-open Access, logging on as "DbOwner", and leaving the password blank, as you have not assigned one yet.

7. In the User and Group Accounts dialog, demote the Admin user account by removing it from the Admins group. Now Admin is only a member of the Users group and will have only those permissions assigned to that group by "DBOwner".

8. Create a password for "DBOwner".

9. Close and re-open Access, logging on as "DBOwner" using the password you created in step 8.

10. You can now start to secure the objects in you database.

Special Notes:

• A User account inherits the permiss