How to Create your own Input Box forms and pause code for User input.

In your application you may need to get information or a selection from a user that an a standard Input Box isn't designed to handle. As an example, you may want to offer the user only a selection of one of two choices. Since there's no way to restrict what the user can enter into an input box, an input box won't work well. To get around this limitation you can design a form that acts as psudo input box, opening the form to get input, and then when closed, resuming your code. Here's how: In the declarations section of the module which the running function is in, and for which you need to get the input from the user, dimension new variables which will to hold the return values which the user selects or enters into your input form.The value of these variables will be "visible" to your running function after the user enters their selections. There's no need to make these variables global variables. Add a new sub procedure to the same module as your running function. Your custom input box form will call this sub procedure. The purpose of this sub procedure is solely to accept the values from your input form as parameters and to set the new module level variables equal to the value of the parameters. Design your own "input box" form as a dialog box form. When a dialog box is opened, it will cause your running code to "pause" until the dialog is closed. (You have to specifically specify opening it in your running function as "acDialog".) In the OnClose event of your input box form, now add a call to the sub procedure you just wrote. Specifying as parameter values, the values of the text boxes or option groups etc. from your form. This will send the data back to your module when the dialog is closed. You can also make your main code pause and wait for the user's input and for non-dialog style forms by using code like the following in you main procedure ( an " _ " means the line continues on the next line show here): DoCmd OpenForm "MyForm", acNormal While SysCmd(acSysCmdGetObjectState, acForm, _ "My Form Name") = acObjStateOpen DoEvents 'Do Nothing Wait for Closing Wend [Resume Code here] You can also include a parameter in your sub procedure to notify your running function if the user clicked a cancel button rather than an OK button to end your process.

Back to the Tips List

Code to Return the Last Day of the Month, the Beginning of a Quarter or End of a Quarter Based on a Specific Date

Access' Date Add and DateDiff functions generally fill most needs for date manipulation. However, there are a few instances where you need to return a date for comparison purposes which are not simple additive date result from a current date. Two examples are specifying the date for the end of the current month (e.g. for billing purposes), or gathering data which occurs, or is scheduled to occur based on whether it is after the beginning of a quarter, or before the end of a quarter. The following two functions provide the code to determine the end of the month from a specific date and the first or last day of any yearly quarter based on a specific date. (The second function below, providing the quarterly dates relys upon the end of the month function so both must be included in your module.) Here's the end of the month function: Function EOMonth (Anydate) '------------------------------------------------------------------------------- 'Purpose: Returns the last day of the month for the date specified 'Accespts: A Date or Date Variable. 'Returns: VarType 7 Date '------------------------------------------------------------------------------ On Error GoTo Err_EOM Dim NextMonth, EndofMonth NextMonth = DateAdd("m", 1, Anydate) EndofMonth = NextMonth - DatePart("d", NextMonth) EOMonth = EndofMonth Exit_EOM: Exit Function Err_EOM: MsgBox "Error" & " " & Err & " " & Error$ Resume Exit_EOM End Function Here's the Function to determine the beginning date or ending date of any quarter base on a date supplied: Function BEQuarter (ByVal Anydate, BeginOrEnd As Boolean) As Variant '------------------------------------------------------------------- 'Purpose: Returns the beginning or the end of a quarter 'Uses: EOMonth() Function 'Input: AnyDate: A date value, use of #'s to signify a date when variable ' from a query or the immediate window. '' BeginOrEnd: 0 Finds Beginning of Quarter, -1 Finds End of Quarter ''Returns: VarType 7 date '--------------------------------------------------------------------- On Error GoTo Err_EOQ If BeginOrEnd <> 0 And BeginOrEnd <> -1 Then MsgBox "Error: BeginOrEnd must be 0 or -1" GoTo Exit_EOQ End If Dim EndofQuarter, BeginofQuarter, PrevQuarter Static MonthVar(12) As Integer If MonthVar(12) = 0 Then MonthVar(1) = 2 MonthVar(2) = 1 MonthVar(3) = 3 MonthVar(4) = 2 MonthVar(5) = 1 MonthVar(6) = 3 MonthVar(7) = 2 MonthVar(8) = 1 MonthVar(9) = 3 MonthVar(10) = 2 MonthVar(11) = 1 MonthVar(12) = 3 End If Anydate = Anydate - DatePart("d", Anydate) EndofQuarter = DateAdd("M", MonthVar(DatePart("M", Anydate)), Anydate) EndofQuarter = EOMonth(EndofQuarter) If DatePart("m", EndofQuarter) = 6 Then BeginofQuarter = DateAdd("q", -1, EndofQuarter) + 2 Else BeginofQuarter = DateAdd("q", -1, EndofQuarter) + 1 End If If BeginOrEnd = -1 Then BEQuarter = EndofQuarter Else BEQuarter = BeginofQuarter End If Exit_EOQ: Exit Function Err_EOQ: MsgBox "Error" & " " & Err & " " & Error$ Resume Exit_EOQ End Function

Back to the Tips List

How to Test Whether an Instance of the Application is Already Running when the Application is Launched

To prevent a second instance from loading if a user mistakenly attempts to launch it twice, you can run code from your autoexec macro to test whether the app is already running and terminate the launch if a copy of it is already open. To do this, incorporate the two following simple functions in your database and call the Function IsRunning below: Function IsRunning() as integer Dim db As Database Set db = CurrentDB() If TestDDELink(db.Name) Then IsRunning = -1 Else IsRunning =0 End If End Function ' Helper Function Function TestDDELink (ByVal strAppName$) As Integer Dim varDDEChannel On Error Resume Next Application.SetOption ("Ignore DDE Requests"), True varDDEChannel = DDEInitiate("MSAccess", strAppName) ' When the app isn't already running this will error If Err Then TestDDELink = False Else TestDDELink = True DDETerminate varDDEChannel DDETerminateAll End If Application.SetOption ("Ignore DDE Requests"), False End Function This code works in all versions of Access.

Back to the Tips Index

Add Pizzazz to your Message Boxes by varying the font weight.

Access 97 allowed you to break your message box into paragraphs, and to bold the first paragraph in the Message Box, just like Access itself does with standard messages. However, creating this functionality in Access 2000 or 2002 is a bit more limited and tricky as noted below. The "@" symbol added to your message text will break the message into paragraphs, with text before the first @ shown in bold. You are limited to three paragraphs with the "@" symbol following each paragraph.  If you only want to break for two paragraphs, you must use two @@ symbols at the end of the second paragraph. The following code shows a formatted message box for Access 95-97: If MsgBox("You have just deleted the current record.@ _ Click ""OK"" to confirm your delete or ""Cancel"" to undo your deletion.@@ ", _ vbOKCancel, "My AppName") = vbOK Then 'Do somthing here End If In Access 2000 and 2002 (Xp), this functionality is not directly available because the VBA environment is now separate from Access.  You can however replicate it (with certain limitations) by using the EVAL() function as a wrapper around the message box code.  So it would look like: If Eval("MsgBox('You have just deleted the current record.@ _ Click ""OK"" to confirm your delete or ""Cancel"" to undo your deletion.@@', _ 1, 'My AppName')") = vbOK Then 'Do somthing here End If Note: You can not use variables in your message boxes using this method and you also can't use VB intrinsic constants such as vbOKCancel, the latter must be given as specific numbers which you can obtain using the object browser.

Back to the Tips Index

How to Hide the Main Access Window when Running a Form Shortcut from the Desktop

If you have placed a short cut to an Access form on the Windows desktop, you may not want the main Access window to be displayed when your form is opened. There is no way to hide the window entirely if a form is launched from the desktop, Access will flash on the screen momentarily; but you can quickly hide the main Access window using the following code and steps: If you don't want the Access splash screen to show, you can replace it with your own splash screen by creating a bitmap of your splash screen, naming it the same name as the database the form is in, and then placing it in the same directory as the db.   Add the following code to your form module in the declarations section: Const SW_HIDE = 0 Private Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, _ ByVal nCmdShow as Long) As Long In the form On Open event add the following code: Dim lngReturn as Long lngReturn = ShowWindow(Application.hwndAccessApp, SW_HIDE) In the form or report's On Close event add the code: Application.Quit This last piece of code, to quit the application, is required to be added to what ever form will last be visible, be it a switch board form or single form. If you don't add this code, the form will be closed, but Access will still be running in the background, hidden from view. Note: This tip only works with Pop Up or modal forms and will not work with reports. This tip submitted by Larry Christopher

Back to the Tips List

How Do I Open My Application's Help File to the Contents or to a Specific Item in the Index/Search Section

Often you may want to take specific actions when opening the help file for your application. Access provides the ability to open the help file to a specific topic. But if you want to make sure that when you open the file it opens the search index on a specific topic or that it opens to the Contents (under Win95/NT) then you need to use the WinHelp api function. Here's how to do it: To open to a specific help search/index topic call your help file as follows, where "strHelpVal" is the name of an index topic: Private Declare Function WinHelp Lib "user32" Alias _ "WinHelpA" (ByVal hWnd As Long, ByVal lpHelpFile As String, _ ByVal wCommand As Long, ByVal dwData As Any) As Long Const HELP_PARTIALKEY = &H105& Public Function WHPartialKey() Dim dwReturn% Dim strHelpVal$ strHelpVal = "Active Window" & Chr$(0) 'vbnullstring in A 95 and 97 dwreturn = WinHelp(Application.hWndAccessApp, "acmain80.hlp", _ HELP_PARTIALKEY, strHelpVal) End Function To open the help file to the general contents use the following (note if the user last had the index showing this will open the file on the index tab, if the contents were showing it will open the contents): Private Sub cmdHelp_Click() On Error Resume Next Dim dwReturn& dwReturn= WinHelp(Me.hwnd, "acmain80.hlp", &HB, 0&) End Sub

Back to the Tips List

How Can I Check If a Network Drive Is Available?

Your application may need to access a file on a network drive or attach to tables for a backend database on a network drive. Prior to actually performing that action you may want to check to see if the network connection is available. Here's a function to do just that: Private Declare Function prn_WNetGetConnection Lib "mpr.dll" _ Alias "WNetGetConnectionA" (ByVal LocalName$, ByVal RemoteName$, _ cbRemoteName&) As Long Private Declare Function prn_WNetAddConnection Lib "mpr.dll" Alias _ "WNetAddConnectionA" (ByVal NetPath$, Password, LocalName&) As Long Const ERROR_NO_ERROR = 0 Const ERROR_ACCESS_DENIED = 5 Const ERROR_BAD_NETPATH =53 Const ERROR_BAD_NET_NAME = 67 Const ERROR_ALREADY_ASSIGNED = 85 Const ERROR_INVALID_PASSWORD = 86 Const ERROR_MORE_DATA = 234 Const ERROR_INVALID_ADDRESS = 487 Const ERROR_BAD_DEVICE = 1200 Const ERROR_CONNECTION_UNAVAIL = 1201 Const ERROR_DEVICE_ALREADY_REMEMBERED = 1202 Const ERROR_NO_NET_OR_BAD_PATH = 1203 Const ERROR_NO_NETWORK = 1222 Const ERROR_NOT_CONNECTED = 2250 Public Function at_CheckNet%(DriveOrPrinter$) '------------------------------------------------------------ 'Purpose: To check to see if a drive or printer on the network is available 'Accepts: Drive as "C:","LPT3:" or "\\network_server\drive" 'Returns: True (-1) on Success, False (0) on Failure '------------------------------------------------------------- On Error GoTo Err_CN Dim dwError& Dim RemoteNamesz& Dim RemoteName$ at_CheckNet = True If Instr(DriveOrPrinter, "\\") < 1 Then 'local named resource RemoteName = String(255, 0) RemoteNamesz = Len(RemoteName) dwError = prn_WNetGetConnection(DriveorPrinter, RemoteName, RemoteNamesz) If dwError = ERROR_CONNECTION_UNAVAIL or _ dwError = ERROR_NOT_CONNECTED Or _ dwError = ERROR_NO_NETWORK Then at_CheckNet = 0 GoTo NetMsg End If Else 'a network address is supplied to the function 'we supply a null password, which may be required & a null connection name 'since we're not actually connecting, just checking the connection 'will return ERROR_DEVICE_AREADY_REMEMBERED if available dwError = prn_WNetAddConnection(DriveOrPrinter, Null, 0&) If dwError = ERROR_NO_NETWORK Or _ dwError = ERROR_NOT_CONNECTED Or _ dwError = ERROR_CONNECTION_UNAVAIL Or _ dwError = ERROR_NO_NET_OR_BAD_PATH Or _ dwError = ERROR_ACCESS_DENIED Or _ dwError = ERROR_BAD_NETPATH Or _ dwError = ERROR_BAD_NET_NAME Then at_CheckNet = 0 GoTo NetMsg End If End If GoTo Exit_CN NetMsg: MsgBox "The required network device is not currently available.", 16, "Check Net" Exit_CN: Exit Function Err_CN: MsgBox "Error: " & Err & " " & Error$, 16, "Check Net" Resume Exit_CN End Function Note: If you want to actually create a network connection using WNetAddConnection, change the last parameter call in the declarations to ByVal LocalName as String, rather than a long or integer, and pass your local drive or port connection like "c:".

Back to the Tips List

How to Determine If a File Exists and if it is Locked by Another Process.

Access provides the built in Dir() command that can determine if a file or directory exists but that function can not tell you if the file is locked or otherwise useable. (e.g. if you need to move the file, write to it or for an Access jet db backend, whether it may be compacted.) To gain that information you can use the following API call to the CreateFile function. 1. On the declarations page of your module, add the following functions Private Declare Function CreateFile& Lib "kernel32" Alias "CreateFileA" (ByVal _ lpFileName as String, ByVal dwDesiredAccess as Long, ByVal dwShareMode as Long, _ lpSecurityAttributes As Any, ByVal dwCreationDisposition as Long, _ ByVal dwFlagsAndAttributes as Long, ByVal hTemplateFile as Long) Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject as Long) as Long 2. The following function can be called to check for file existence and whether the file is unlocked and writeable or moveable. (Note an " _ " underscore means line continuation): Public Function FileExists(strFileName As String, ChkType As Byte) As Long '--------------------------------------------------------------------------- _ Purpose: Checks for file existence and read/write capability. _ Returns: File handle number (>0) if file exists and is useable based on the ChkType _ a negative number if there is an error (e.g. the file is not found or is locked.) _ ChkType: 1=Check for existence, 2= Check for file lock, 3 = Check if file is share writeable. _ ---------------------------------------------------------------------------- Dim lngFileHandle As Long Dim lngLastError As Long Const FILE_SHARE_READ = &H1: Const FILE_SHARE_WRITE = &H2 Const GENERIC_READ = &H80000000 Const GENERIC_WRITE = &H40000000 Const OPEN_EXISTING = 3& 'Possible return Error values (multiplied by -1) Const INVALID_FILE_HANDLE = -1 Const ERROR_FILE_NOT_FOUND = 2: Const ERROR_PATH_NOT_FOUND = 3 Const ERROR_ACCESS_DENIED = 5: Const ERROR_INVALID_DRIVE = 15 Const ERROR_DEVICE_NOT_READY = 21: Const ERROR_SHARING_VIOLATION = 32 Const ERROR_LOCK_VIOLATION = 33: Const ERROR_NETWORK_UNREACHABLE = 1231 Select Case ChkType Case 1 'Simple check for existence, no read-write desired lngFileHandle = CreateFile(strFileName, 0, 0, ByVal 0&, OPEN_EXISTING, _ 0, ByVal 0&) Case 2 'Check whether file is locked if write access is desired lngFileHandle = CreateFile(strFileName, GENERIC_READ Or GENERIC_WRITE, _ 0, ByVal 0&, OPEN_EXISTING, 0, ByVal 0&) Case 3 'Read-write desired, share allowed lngFileHandle = CreateFile(strFileName, GENERIC_READ Or GENERIC_WRITE, _ FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, ByVal 0&) End Select CloseHandle (lngFileHandle) lngLastError = Err.LastDllError If lngLastError <> 0 Then FileExists = lngLastError * -1 Else FileExists = lngFileHandle End If End Function 3. It is important to note that your function must include the code to close the process handle after the shelled application is complete, otherwise you will have a memory leak until you shut down Windows.

Back to the Tips List

How to Save Memory When Writing VBA Code

Access and VBA generally do a good job of "cleaning up" memory when they are done running your code. But there are a number of common coding methods used by developers which hinder Access' release of memory. Here's some steps to take in writing functions to save memory and speed your application: Often you see constants declared in modules in the general declarations section, even when they are used only by one function; especially with API calls. Move your constants to the function which uses them when at all possible so that Access will automatically release their memory when the function ends. Constants declared at the module level will remain in memory for the life time of the application.   Avoid where at all possible global variables, i.e. those declared with Global. They are often bad programming. Rather create a function or sub which can be called to set a variable in a particular module when necessary, or write your functions to use the inherent "call back" capability in VBA when you declare parameters by reference rather than by value. i.e. if you need to retrieve the value of a variable after a function is run, pass that variable as a parameter to the function by reference. When the called function changes the value of the parameter as it runs then the code that calls that function can reference the new value of the the parameter it specified after the called function finishes.   If you declare variables at the module level so that they are visible to multiple functions, de-initialize them at the end of the last function which uses them. This is especially true for string variables which have tremendous overhead associated with them (Mystring = "" sets the string to a zero length). Be sure your code re-dimensions arrays to zero (ReDim myarray(0)) or Erase myArray() when done.   If you are using Class modules in Access, be sure to de-initialize variables in the class terminate function.   Managed data access objects efficiently.  This can entail: a.) Set DAO, ADO and to be equal to "Nothing" once the code is done using them. This releases the pointer to the object.  b.) Don't wait until the end of the function to close record sets that your code uses when the function no longer needs them. Close the record set as soon as possible and release the memory. Failure to close and release DAO and ADO record sets and database object variables when repeated tables or queries are opened is a major source of "Out of Memory" errors and "Can't open any more databases [or tables]" errors etc. c.) If you create a reference to a database object (i.e. CurrentDb, or CurrentConnection) in a function which in turn calls other functions which also opens record sets, pass the database connection variable to the second function rather than opening a second instance of the record set to the database.   If you know the length of a string to be allocated to a variable, then set the variable's length by using the notation "MyStringVar as String * X" where X equals the length of the string in characters. Access allocates more memory to variable length strings.   Avoid using variables which are variants unless you have the possibility of null values; and dimension variables to their smallest size, e.g. use byte variables where appropriate rather than integers.   If you use certain functions in your application only for specific actions, separate these functions into a unique and separate module. Access will only load the functions into memory when they are used saving memory and load time.

Back to the Tips List

How to Compile VBA code by Command from with a VBA Module.

If your application exports forms, reports or modules to another database (e.g. an update or repair database sent to a client site,) you can have the application call an undocumented sys command function in Access to compile the VBA modules in the target database once the export is completed. The Sys Command function to call is SysCmd 504, 16483; as example, the following code creates a new module in a target database and then compiles and saves the code in that database. Function CreateMod(strTargetDbName as String) Dim objAccess as Object Dim objModule as Object Set objAccess = CreateObject("Access.Application") objAccess.OpenCurrentDatabase (strTargetDbName) 'Create a module objAccess.DoCmd.RunCommand acCmdNewObjectModule Set objModule = objAccess.Modules(objAccess.Application.CurrentObjectName) 'Now add some code objModule.InsertText "Global Const Is_Admin as Boolean = True" objModule.InsertText "Global Const APP_Name = 'SuperApp'" objModule.InsertText "Function MyFunction(ByVal lngValue1&, ByVal strValue2$) As String" objModule.InsertText "'Code is intentionally not present" objModule.InsertText "End Function" objAccess.DoCmd.Close acModule, objModule, acSaveYes objAccess.DoCmd.Rename "basSomeModuleName", acModule, objModule 'Now compile the module and quit objAccess.SysCmd 504, 16483 'Compile and save objAccess.CloseCurrentDatabase objAccess.Quit Set objAccess = Nothing End Function

Back to the Tips List

 

How write code that converts between Access versions (Determining whether a db is an MDE/ADE)

Shown below is a function that can be run in your database to determine if the application is an MDE or ADE database.  This is useful to determine if you have design access to objects within the database. This function works in databases using ADO or DAO data access methods in Access 97, 2000 or 2002.   This code demonstrates how to make code convertible between Access versions by using Object as an object type rather than a direct reference to an Access or Data Access object (e.g. in the example below setting App as an Object rather than as "as Application". This causes code to use late binding of object properties, thereby allowing object properties (such as in this case CurrentProject) to be specified and to compile successfully even in versions of Access where that property is not generally available. Function TestMDE() As Boolean On Error Resume Next Dim App As Object Dim dbs As Object Dim strMDE As String Const ACCESS_ADP = 1 Set App = Application 'late bind to the Access.Application object If CInt(Val(SysCmd(acSysCmdAccessVer))) > 8 Then If App.CurrentProject.ProjectType = ACCESS_ADP Then Set dbs = App.CurrentProject Else Set dbs = CurrentDb() End If Else Set dbs = CurrentDb() End If strMDE = dbs.Properties("MDE") If Err = 0 And strMDE = "T" Then TestMDE = True Else TestMDE = False End If Set dbs = Nothing End Function

Back to the Tips List

 

How to Call a Function or Sub Procedure when the Procedure Name is stored in a Table.

In certain applications you may need to call a function or sub procedure from a list of functions and subs stored within a table.  To do so you can use the built in Eval() function to cause the function to be executed and pass the function or sub parameters. As an example, the following code shows how to execute a function who's name is stored in a table; the function name is fetched by a combo box on a form that shows a series of specific reports and contains a hidden column that has the name of the function that compiles the data for the report.  The function requires one parameter, which is pulled from the form. Private Sub RunCompile() On Error Resume Next Dim dwReturn as Long wReturn = Eval(Me!cboReportToCompile.Column(1) & "(" & Me!txtParamTextBox & ")") Docmd.OpenReport Me!cboReportToCompile.Column(0), acViewPreview End Sub The same structure can be used to pull and execute a function name returned in a record set.

  Back to the Tips Index

 

Maintaining the Internal Integrity of Compiled VBA Code in A Database

When developing Access databases that contain VBA code, over time as you add and delete VBA code in the database, the internal compiled VBA section of the database file can become bloated, fragmented and from time to time, corrupt causing crashes of the application.  This is because when VBA code is deleted in the editor, the internal compilation is simply marked as unused, but is not always overwritten or deleted. There is a method available to eliminate this fragmentation and potential corruption called decompiling a database (MDB and ADP dbs only).  This process marks all the compiled VBA in the database to be deleted and when followed by a compact and repair, "cleans out" the database file, eliminating all compiled code (but not written code) so that with the next compile of the VBA only the current code is compiled internally in the db: Create a back up of the database.   Create a shortcut on your desktop to the MSAccess.exe executable.   Right click on the shortcut and bring up its properties.   In the Target text box, add a path to your database, with the path in quotations, followed by the undocumented switch /decompile so that the string looks like this:   c:\program files\microsoft office\office\msaccess.exe "c:\some dir\some file.mdb" /decompile   (All on one line)   Note that the path the the Access executable will be specific to your system.   Holding down the shift key, execute the shortcut.   Holding down the shift key, compact and repair your database (this will clean out all the compiled code in the database, but not the written code.)   Open any module and compile the database again.   Compact and repair your database one more time. This procedure although part of routine maintenance for dbs it not something that normally needs to be done very frequently; it could be done following major development work or prior to distribution of the application.

Back to the Tips List