If you don’t like to use DOS commands then you can change the Default Database Folder setting with the following VBA Statement:

Application.SetOption "Default Database Directory", "C:\Developers\Project"

The above statement will change the Default Database Folder to the location specified in the second parameter. The next example changes the Default Database Folder to the active database’s location:

Application.SetOption "Default Database Directory", CurrentProject.Path

You can execute the above commands directly in the Debug Window. After executing any of the above commands you may open Access Options from Office Buttons and check the Default Database Folder control value under the Popular options group.

We have already discussed earlier about Updating/Appending data into external Database Tables (external Tables of Access, dBase etc. not linked to the active Access Database)  by using the IN Clause in Queries.  You will find that Article here to refresh your memory.

If you have Queries in your Databases that references Tables in external databases to Update or Append data into them, like the sample SQL given below, it is time to take a relook at them to avoid unexpected side effects.

INSERT INTO Employees (EmployeeID, LastName ) IN 'C:\Developers\Projects\Northwind.mdb'
SELECT 100221 AS EID, "John" AS LN;

If external or backend database is on a common location on Local Area Network (LAN) Server, serviced by several front-end databases from client machines that itself is asking for separate treatment of the whole issue which we will look at them later, probably next Week. I don’t want to mix them up here and confuse you.

Coming back to the IN Clause in the above SQL, if the external database and the current database is on the same Folder then you can omit the lengthy Pathname in the external database reference, like the modified SQL given below:

INSERT INTO Employees (EmployeeID, LastName ) IN 'Northwind.mdb'
SELECT 100221 AS EID, "John" AS LN;

The main advantage of writing the IN Clause in this way is that you don’t have to change the PathName in all SQLs of Queries on location change of your application. The down side is that you have to ensure that the Default Database Folder location changes to the active database’s folder, otherwise the Queries will look for the external database in the old location for updating/appending data.  You can do this, either using the SetOption method or using the ChDir() Command. Both methods are given below for reference:

SetOption Method:

SetOption "Default Database Directory", CurrentProject.Path

This method permanently changes the Default Database Folder control value in the Access Options area and remains intact till it is changed again.  This is a global change to Access Options and may affect other databases when they are open.

ChDir() Method:

Public Function ChangeDir()
Dim vDrive As String * 1, sysPath As String

'get current database Path
  sysPath = CurrentProject.Path

'extract the drive letter alone
'vDrive Variable is dimensioned to hold only one character
  vDrive = sysPath 

'change control to the Drive
  ChDrive vDrive 

'change current location to the database path
  ChDir sysPath 

End Function

This method is harmless because the change is temporary and the Default Database Folder global setting remains intact. You can use the above Code in databases that requires this Function. 

One of these methods must be run immediately on opening the database, either through an Autoexec Macro with the RunCode Action or through the Form_Load() Event Procedure of the first Form opened.

• Access Security Key Diagram
• Updating Sub-Form Recordset from Main Form
• Easy Reference: Access2003 Commands in Access2007
• IIF vs Switch function in MS-Access
• Preparing Rank List

MkDir "C:\Developers\Projects"

The only disadvantage of this method is that we cannot perform a validation check before executing this command.  In the VBA program we have included the validation checks.  That program uses constant values as Path, and with few modifications this program can be further improved to accept the Path string as Parameter to the CreateFolder() Function.  The Code with improvements is given below:

Public Function CreateFolder(ByVal folderPath As String)

Dim msgtxt As String, folderName As String

'extract the new Folder Name from the folderPath Parameter
folderName = Right(folderPath, Len(folderPath) - InStrRev(folderPath, "\"))

'check for the new folder name, if not found proceed to create it
If Dir(folderPath, vbDirectory) = "" Then
   msgtxt = "Create new Folder: " & folderPath & vbCr & "Proceed ...?"
   If MsgBox(msgtxt, vbYesNo + vbDefaultButton1 + vbQuestion, "CreateFolder()") = vbNo Then
      Exit Function
   End If
   MkDir folderPath 'try to create the new folder

'check whether the folder creation was successful or not
   If Dir(folderPath, vbDirectory) = folderName Then
      msgtxt = folderPath & vbCr & "Created successfully."
      MsgBox msgtxt
   Else
'if the code execution enters here then something went wrong
      msgtxt = "Something went wrong," & vbCr & "Folder creation was not successful."
      MsgBox msgtxt
   End If
Else
  'the validation check detected the presence of the folder
   msgtxt = folderPath & vbCr & "Already exists."
   MsgBox msgtxt
End If

End Function

In all the above and earlier examples we have provided the full path of the existing location, where we need the new folder to be created, with the new folder name at the end.  If you are sure where the current location is (or active location of the current database on disk) then you can issue the MkDir() command with the new folder name alone, like the following example:

MkDir "Projects"

As far as VBA is concerned the current location is not what you have selected using the Windows Explorer. Or the one you have selected using DOS Command ChDir() run directly under the DOS Command Prompt.

But, with a small trick we can find out which is the current folder that VBA is aware of, that is by running the Shell() command directly from the Debug Window to invoke the DOS Command Prompt from VBA, like the example given below:

Call Shell("cmd.exe")

The above command will open the DOS Command Prompt (if it is minimized on the task bar then click on it to make that window current), the Cursor will be positioned in the current folder. Check the sample image given below:

If you have used MkDir "Projects" like command without knowing where it is going to be created then type Dir and press Enter Key to display a list of files and directory names with the label <Dir> to indicate they are folders.

That doesn’t mean that the above method is the only option to check the Default Database Folder location.  Select Access Options from Office Button and select the Popular Option Group(Access2007) and you can see the Default Database Folder settings there.  Check the image given below:

Try to open a database from some other location on disk, but this setting will not change and the Default Database Folder will remain active as per this setting.  Without touching the above Access default setting we can change the active folder to the newly opened database’s parent directory with the use of the following DOS Commands from VBA (you can try this by typing these commands directly on the Debug Window):

? CurrentProject.Path

This is not DOS Command, but the above VBA statement retrieves the active database’s Path. Let us assume that the retrieved location of the current database is: C:\MDBS

Using the above information in the next two DOS Commands we can change the control to the active database’s location, without changing the Default Database Path setting, we have seen earlier:

ChDrive "C" 'change control to C: Drive.  This is necessary if control was on a different drive
ChDir CurrentProject.Path 'change control to the active database's folder

By combining the above statements we can write a very useful Function ChangeDir() to change the control to the current Database Folder.  Copy and Paste the following Code into a Standard Module of your Database and save it:

Public Function ChangeDir()
Dim vDrive As String * 1, sysPath As String

'get current database Path
  sysPath = CurrentProject.Path

'extract the drive letter alone
'vDrive Variable is dimensioned to hold only one character
  vDrive = sysPath 

'change control to the Drive
  ChDrive vDrive 

'change current location to the database folder
  ChDir sysPath 

End Function

Call the above Function from an Autoexec macro with the RunCode Action or from the Form_Load() Event Procedure of the first Form open (like the Startup Screen or Main Switchboard) to change control to the active database folder.

• Updating Sub-Form Recordset from Main Form
• Easy Reference: Access2003 Commands in Access2007
• IIF vs Switch function in MS- Access
• Preparing Rank List
• Restoring Disabled Full Menus Access2007

Once we determine the presence of a file in a folder with the Dir() Command we can do certain operations on the file, like opening that file in it’s parent application through the Shell() Command or make a copy of that file to a different location with the FileCopy() Command or delete it with the Kill() Command.

Example-1: Check for the presence of a text file in a folder and if found open it in Notepad.exe

Public Function OpenTextFile()
Dim txtFilePath As String
Dim NotePad As String

   txtFilePath = "C:\msaccesstips\htaccess.txt"
   NotePad = "C:\Windows\System32\Notepad.exe"

If Dir(txtFilePath, vbNormal) = "htaccess.txt" Then
   Call Shell(NotePad & " " & txtFilePath, vbNormalFocus)
Else
   MsgBox "File: " & txtFilePath & vbcr & "Not Found...!"
End If

End Function

Example-2: Make a copy of the file with the FileCopy() Command.

Public Function CopyTextFile()
Dim SourcefilePath As String
Dim TargetFilePath As String

   SourcefilePath = "C:\msaccesstips\htaccess.txt"
   TargetFilePath = "C:\New Folder\htaccess.txt"

If Dir(SourcefilePath, vbNormal) = "htaccess.txt" Then
   FileCopy SourcefilePath, TargetFilePath
   MsgBox "File copy complete."

Else
   MsgBox "File Not Found...!"
End If

End Function

Example-3: Find and Delete a File from specific location on Hard Disk.

Public Function DeleteFile()
Dim FilePath As String, msgtxt As String

   FilePath = "C:\New Folder\htaccess.txt"

If Dir(FilePath, vbNormal) = "htaccess.txt" Then
   msgtxt = "Delete File: " & FilePath & vbCr & vbCr
   msgtxt = msgtxt & "Proceed...?"
   If MsgBox(msgtxt, vbYesNo + vbDefaultButton2 + vbQuestion, "DeleteFile()") = vbNo Then
      Exit Function
   End If
   Kill FilePath
   MsgBox "File: " & FilePath & vbCr & "Deleted from Disk."

Else
   MsgBox "File: " & FilePath & vbCr & "Not Found...!"
End If

End Function

Dir() Function also can be used for checking the presence of a folder in preparation for creating a new folder in a particular location on the Hard Drive.

The following Command checks for the presence of a particular folder on C: drive:

strOut =  Dir("C:\Developers\Projects", vbDirectory)

The second parameter vbDirectory tells the Dir() command what to look for and if the folder Projects found under C:\Developers folder, then the folder name Projects returned in the strOut variable, otherwise returns an empty string.

The MkDir() Command can be used for creating a new folder if the Projects folder doesn’t exists.

Let us write a small program to check the presence of Projects folder and if it doesn’t exists then let us create the folder.

Public Function CreateFolder()
Dim folderPath As String
Dim msgtxt As String

folderPath = "C:\Developers\Projects"

If Dir(folderPath, vbDirectory) = "" Then
   msgtxt = "Create new Folder: " & folderPath & vbCr & "Proceed ...?"
   If MsgBox(msgtxt, vbYesNo + vbDefaultButton1 + vbQuestion, "CreateFolder()") = vbNo Then
      Exit Function
   End If
   MkDir folderPath
   If Dir(folderPath, vbDirectory) = "Projects" Then
      msgtxt = folderPath & vbCr & "Created successfully."
      MsgBox msgtxt
   Else
      msgtxt = "Something went wrong," & vbCr & "Folder creation was not successful."
      MsgBox msgtxt
   End If
Else
   msgtxt = folderPath & vbCr & "Already exists."
   MsgBox msgtxt
End If

End Function

Dir() Command can be used to check the Volume label of a Disk Drive.

The following command, run directly from the Debug window, gets the Volume Label of the Hard Drive, if exists, otherwise returns an empty string:

? Dir("D:", vbVolume)

Result: RECOVERY

• Updating Sub-Form Recordset from Main Form
• Easy Reference: Access2003 Commands in Access2007
• IIF vs Switch function in MS- Access
• Preparing Rank List
• restoring Disabled Full Menus in Access2007

Disk Operating System Commands (both Internal and External) are directly used under Command Prompt for managing Files, Folders on Disks and for retrieving information on them.

For example, the Directory Command (Dir /S/B/P) will provide a list of all files with full Path Names (like C:\My Documents\New Folder\Resume.doc) from your C: Drive and display them on screen, one page at a time. 

Let us try an example.

Click on the Start Menu.

Type cmd and press Enter Key, DOS Command window will open up with the Command Prompt C:\>.  Type the following Command to display a list of Folders/Files from your C: drive, one page at a time.  You must press a Key to advance the list from one page to the other.

Warning:  The list of Folders/Files on your C: drive will run into hundreds of pages.  Press Ctrl+C (break the command) to terminate the list from displaying further.

C:\> Dir /S/B/P

C:\> is the command prompt

Dir (command stands for Directory)

Command switch /S includes Files in Sub-directories also in the output.

Command switch /B provides a bare-formatted list of files, i.e. gives only file path names without creation date, file sizes or any other information of files.

Command switch /P displays the output on Screen one Page (one screen full) at a time.  Needs to press a Key on the Keyboard to advance the list of files to the next Page.

If you want to save the entire list into a text file, without page breaks, issue the following command with the output redirection symbol (>) with a text file name.  The re-direction symbol will send the output of the Directory command to a specified text file, without displaying them on screen.

C:> Dir /S/B > myDirList.txt

Note: Leave a space on either side of the > symbol.

You may open myDirList.txt file in Notepad and check the contents. You can display the contents of myDirList.txt file with the following DOS Command:

C:\> TYPE myDirList.txt

Press Ctrl+C to stop the runaway display. TYPE command displays the contents of a text file on screen. But, it will not display the output one screen full at a time. To do that we can seek the help of another DOS command: MORE with the use of piping symbol (|).

C:\> TYPE myDirList.txt | MORE

In the above command we are using the piping symbol (|) to join the TYPE filename.txt | MORE commands to get the required output. The TYPE command reads the text file contents and pass it on to the next command MORE, without directly sending the output to the Screen. MORE Command takes it’s input from TYPE command, through the pipe, and displays it one screen-full at a time. Press SPACEBAR to display the next screen-full of text.

OR

C:\> MORE < myDirList.txt

If > (greater than) symbol is known as re-direction symbol in DOS then < (less than) symbol is known as Source symbol for the MORE command. MORE command reads data from the file name given immediately after the Source Symbol (<) and displays one screen-full at a time.

Let us come back to the Dir Command, it is available in VBA also. But it is used for a different purpose. We can use this command to check the presence of a particular file or the presence of any file in a folder. The usage of this command is as shown below:

strOutput = Dir("C:\My Documents\Resume.doc", vbNormal) 

The Dir Command checks for the presence of Word File Resume.doc in Folder C:\My Documents, if found then the file name ‘Resume.doc’ is returned in strOutput Variable, otherwise it will return an empty string.

strOutput = Dir("C:\My Documents\*.*", vbNormal) 

This command will get the first file name and save it in strOutput Variable. You may try out this command in the Debug Window directly, like:

? Dir("C:\My Documents\*.*")

This will print the first file name found in the folder C:\My Documents in the Debug Window. To get subsequent file names from the same folder you can run the command without any parameters to the function, like:

? Dir()

Note: First time when you run this Command you should provide a Path as parameter otherwise it will end up with error.

Place the insertion point on the Dir() Command and press F1 to display the details of this Command in Access Help Documents.

There are other interesting Windows Operating System Commands like ChDrive, ChDir, MkDir, RmDir etc. and we will learn their usage in VBA Next week.

• Easy Reference: Access2003 Commands in Access2007
• IIF vs Switch function in MS-Access
• Preparing Rank List
• restoring Disabled Full Menus in Access2007
• Running Workgroup Admin in access2007

When we click on the Hyperlink the file (Ms-Word, Excel or Adobe Acrobat pdf file) will open with the first page on top and whatever default view configuration of the document is set.

Another method used to open an external file is DOS (Microsoft Disk Operating System) Shell() Command in VBA.  The Shell() command needs mainly two parameters (actually three values), as the syntax shown below:

Call Shell(“<Parent Application> <file pathname>”, <window mode>)

The first parameter of the Shell() command have two segments, separated with a space.

A.  First Parameter

1. The parent Application Path Name(C:\Program Files (x86)\adobe\Reader 9.0\Reader\AcroRd32.exe).
2. The path name of the pdf file to open (C:\aprpillai\Documents\dosa.pdf).

B.  Second Parameter

1. open window mode

Let us try an example to open a PDF file: C:\aprpillai\Documents\dosa.pdf using the Shell() Command:

1. Open any one your databases or create a new one.
2. Create a new Form with a Command Button on it.
3. Select the Command Button and open it’s Property Sheet (F4).
4. Change the Name property value to cmdRun and change the Caption Property value to Open PDF File.
5. Select the Event Tab of the Property Sheet and click on the On Click Property.
6. Click on the build (. . .) button at the right end of the property to open the VBA Module.
7. Copy and paste the following VBA Code overwriting the existing lines:

   Private Sub cmdRun_Click()
   Dim strApplication As String
   Dim strFilePath As String 
   
   strApplication = "C:\Program Files (x86)\adobe\Reader 9.0\Reader\AcroRd32.exe"
   strFilePath = "C:\aprpillai\Documents\dosa.pdf" 
   
   Call Shell(strApplication & " " & strFilePath, vbNormalFocus) 
   
   End Sub

8. Change the pathname of the pdf file to select a file from your disk with few pages. If you don’t have one then you may download the dosa.pdf file from this Link.
9. Save the Form with the name PDF_Open_Example.
10. Open the form in normal view and click on the Command Button to open the pdf file.

The above Sub-Routine opens the pdf file: C:\aprpillai\Documents\dosa.pdf with Normal Focus in the Acrobat Reader window.

The dosa.pdf (Dosa is Indian Pancake) file have about 51 pages, with variety of recipes. Each recipe with different ingredients like Rava Dosa (on page 7), Sweet Dosa (on page 8), Set Dosa (page 5), Quick Dosa (page 6), Vella Dosai (Page 25), Moong Dosa (page 35) and so on. After opening the Dosa.pdf file with page 1 on the top if we know a particular recipe’s exact page location then we can type the page number on the navigation control, at the bottom of the document, to jump to that page. 

But, if we know this information in advance then we can use the page number value as open parameter to AcroRd32.exe program (..\AcroRd32.exe /A page=25 ..\dosa.pdf) to open the pdf file with that page in view.

We will modify the above program with the addition of Page parameter (..\AcroRd32.exe /A page=25) to jump to the 25th page of the pdf document. Modified program is given below:

Private Sub cmdRun_Click()
Dim strApplication As String
Dim strFilePath As String

strApplication = "C:\Program Files (x86)\adobe\Reader 9.0\Reader\AcroRd32.exe /A page=25"
strFilePath = "C:\aprpillai\Documents\dosa.pdf"

Call Shell(strApplication & " " & strFilePath, vbNormalFocus)

End Sub

NB: Don’t leave any space on either side of the equal sign in ‘page=25’ parameter.  The /A switch must be given after the program name AcroRd32.exe, followed by a space and then page=25.

We have several recipes on the dosa.pdf file and we must be able to go to a particular one quickly with a single click.  To make the task easy we must create a Combo box on the form with a list of all recipes (with page numbers and description) so that we can select a particular recipe and jump to that quickly.

Image of a sample form with the list of Dosa Recipes in a Combo Box is given below:

I will explain the second Combo box (Zoom Percentage) little later. 

1. Open the Form in Design View.
2. Select the Control Wizard tool to launch it when you select the Combobox Tool.
3. Select the Combobox Tool and draw a Combobox on the Form.
4. Select the Radio Button, on the Control Wizard, with the caption ‘I will type the values that I want’ and click Next.
5. Type 2 in the ‘Number of Columns’ control and press Tab Key.
6. Type a similar list of topics, shown in the image above, from your pdf file with Page Number in first column and Description in the second column, when finished click Next.
7. Select the first column and click Next.
8. Type a suitable caption for the child label and click Finish.
9. Select the Combo Box, if it is de-selected, then display the Property Sheet (F4).
10. Change the Name Property value to cboPage.
11. Display the VBA Module of the Form (Design – - > Tools – - > View Code or press ALT+F11).
12. Copy and paste the following VBA Code into the Module overwriting the existing code:

    Private Sub cmdRun_Click()
    Dim ReaderPath As String
    Dim pdfFilePath As String
    Dim PageNumber As Integer
    Dim strOpenPDF As String
    
    PageNumber = Nz(Me![cboPage], 1)' Get user selected page number, if empty then take 1 as default
    
    ReaderPath = "C:\Program Files (x86)\adobe\Reader 9.0\Reader\AcroRd32.exe /A " & "page=" & PageNumber
    pdfFilePath = "C:\aprpillai\Documents\dosa.pdf" 'change the path to match your file location
    
    strOpenPDF = ReaderPath & " " & pdfFilePath
    Call Shell(strOpenPDF, vbNormalFocus)
    
    End Sub

13. Close the VBA Module, Save the Form and open it in normal view.
14. Select one of the item from the Combobox with a larger page number.
15. Click on the Command Button to open the pdf file displaying the selected page. Check the following imge for a sample view of the dosa.pdf file:

    

    As you can see from the header toolbar that the page in view is 7/51 and the document view is only about 60% (zoom=60) of it’s actual size of 100%. We can control the view size of a pdf document by specifying the Zoom parameter immediately after the Page parameter.

    I have created a second Combo Box Control with the name cboZoom on the form, image shown above, and Zoom Percentage values 50,60,70,80,90,100 & 120 so that one of these values can be selected along with the Page number to view the document in the desired size.

The modified Code with the addition of Zoom Parameter is given below:

Private Sub cmdRun_Click()
Dim ReaderPath As String
Dim pdfFilePath As String
Dim PageNumber As Integer
Dim intZoom As Integer
Dim strOpenPDF As String

PageNumber = Nz(Me![cboPage], 1)
intZoom = Nz(Me![cboZoom], 100)

ReaderPath = "C:\Program Files (x86)\adobe\Reader 9.0\Reader\AcroRd32.exe /A " & quot;page=" & PageNumber & "&zoom=" & intZoom
pdfFilePath = "C:\aprpillai\hostgator\dosa.pdf"

strOpenPDF = ReaderPath & " " & pdfFilePath
Call Shell(strOpenPDF, vbNormalFocus)

End Sub

The Page parameter and Zoom parameter values must be joined with an & symbol and there should not be any spaces on either side of the equal (=) sign:

..\AcroRd32.exe /A page=7&zoom=60 C:\aprpillai\Documents\dosa.pdf

When you join parameter key names (page, zoom) and control values (page number and zoom percentage) together the result of it should form like the sample value shown above.

You may create a text box with the name cboZoom on the form and type the zoom percentage value (not to add the % symbol along with the value) and run to test the above code.

NB: If you leave both controls (cboPage and cboZoom) empty the pdf file will open with the first page of the file on top and with 100% zoom value.

• IIF vs Switch function in MS-Access
• Preparing Rank List
• restoring Disabled Full Menus in Access2007
• Running Workgroup Admin in access2007
• Apply Filter to Table directly

Example-1:

Start Time: 21-03-2012 12:30:45

End Time:   21-03-2012 13:30:15

Example-2:

Start Time: 21-03-2012 12:30:45

End Time: 24-03-2012 15:15:15

In the first example the date values in the Start Time and End Time, looks like it is not important, because both are same, to calculate the time difference between them. We can subtract the Start Time value 12:30:45 from the End Time value 13:30:15 and will get the result 00:59:30.  But, if the end time is 01:30:15 past mid-night then how do we calculate the time difference?

But first, how the time changes to zero after 23:59:59 Hrs at night and how this value is held in computer’s memory.  With this basic knowledge working with the date and time values become very easy.

Everybody knows that a day is equals to 24 hours, 1 hour equals to 60 Minutes, 1 Minute equals to 60 Seconds and further if we go to a smaller denomination 1 second equals to 100 milliseconds. If you would like to find out how February gets 29 days (everybody knows about it) but why every 100th Year (like 1700, 1800,1900 or 2100) is not a Leap Year, how every 400th Year become Leap Year and why every 4000th year is not Leap Year, Click here to find out!

So, keeping aside the milliseconds part 1 Day = 86400 Seconds (24 x 60 x 60).  In other words 1 Second = 1/86400 = 0.0000115740740741 Days. Exactly 1 second after midnight the computer’s internal time value will be 0.0000115740740741 and this value keeps adding to the time value at every second interval.  This value can be divided by 100 to get the value equal to 1 millisecond and we could say that value is added to the time value at every millisecond interval. At 12:00 Noon the internal time value is 0.5 (half a day) and at 23:59:59 the internal time value will be 0.999988425926 (in days).  Again this will reset to 0 at 12:00:00 midnight. 

To find out the time difference between time values spread across different dates the date value also should go along with the time value as shown in Example-2 above.  The date-value also mapped in computer’s memory as a continuous number starting 1 from 31-12-1899.  If you create a Date/Time field in your Table having 0 as default value then you will find the date appearing in that field as 30-12-1899, if not filled-in with a date.

The date 21-03-2012 equals to the date number 40989 and the Start Time (Example-2) in memory will be 40989.521354166700, the number after the decimal point is the time value.  Since, the Date and Time values held in memory are real numbers it is easy to find out the difference between them.  All you have to do is to subtract one number from other.  This works with Date/Time Values on the same day or on different dates.

Let us find out the time difference between the date and time values in Example-2:

StartTime = #21-03-2012 12:30:45# = 40989.521354166700

This is the kind of value (Current Date and Time) returned with the function Now().  You can format this value as date alone (dd-mm-yyyy) or time alone (hh:nn:ss) or both combined – format(now(),”dd-mm-yyyy hh:nn:ss”).

Use ? format(StartTime,”0.000000000000”) to display the Date/Time value as a real number from StartTime Variable in the Debug Window.

EndTime = #24-03-2012 15:15:15# = 40992.635590277800

Difference = (EndTime – StartTime) = 3.114236111112 days

So, the result value we get in days, doesn’t matter the date is same or different dates.  If the date is same you will get the result in days something like 0.9999999.  All we have to do is to convert this days into Hours, Minutes and Seconds.

Total_Seconds = Difference x 86400 (difference in days converted into total seconds) = 269070.000000077 Seconds

Hours = Int(Total_Seconds / 3600) = 74 Hrs.

Minutes = int((Total_Second MOD 3600)/60) = 44 Min. 

Seconds = Total_Seconds MOD 60 = 30 sec.

If we assemble all these information into the form of a small function we can easily find the time difference in Hours, Minutes and Seconds  by passing the Start & End Date/Time Values to the Function as parameters.

Copy and paste the following Function Code into the Standard Module and save it:

Public Function HrsMin(ByVal startDate As Date, ByVal endDate As Date) As String
Dim diff As Double
Dim difHrs As Integer
Dim difMin As Integer
Dim difSec As Integer

diff = (endDate – startDate) * 86400
difHrs = Int(diff / 3600)
difMin = Int((diff Mod 3600) / 60)
difSec = (diff Mod 60)

HrsMin = Format(difHrs, "00") & ":" & Format(difMin, "00") & ":" & Format(difSec, "00")

End Function

You may call the Function HrsMin() directly from the Debug Window, as shown below, to test the code:

? HrsMin(#21-03-2012 12:30:45#,#24-03-2012 15:15:15#)

Result: 74:44:30

You may call the function from a Textbox in the Form like:

 = HrsMin([StartDate],[EndDate])

Or from the Query Column like:

 HMS:HrsMin([StartDate],[EndDate])

Or you may run it from VBA Code:

 strHMS = HrsMin(dtSDate,dtEDate)

• Preparing Rank List
• restoring Disabled Full Menus in Access2007
• Running Workgroup Admin in access2007
• Apply Filter to Table directly
• Dynamic Lookup in Query Column

I am sure that Utility Program will help you to save time, otherwise you spent on typing/copy pasting and modifying hundreds of lines of error-trap code in your sub-routines or functions.  The whole idea behind the error handler is to take care of unexpected errors and if necessary report it to the developer so that the logical error can be rectified once and for all.  Besides that the program should not break the code unexpectedly. If it is a minor issue the user can ignore and continue to do what he/she is doing.

A particular Project will have hundreds of Sub-Routines/Functions in Standard Modules and Form/Report Modules.  When the error message pops up the message will carry the Error Number and Error Description.  The message box’s title will carry the Function/Sub-Routine name, if this is included in the title parameter of the MsgBox() Function.  But, the user may not notice this valuable information to pass on to the programmer so that he can go directly into that program and do what he needs to do to rectify the error. 

A better approach to these kind of issues is to create a common Error Handler Program and maintain an Error Log Text File on disk.  When an error occurs in a Function/Sub-Routine call the common Function with the necessary parameters (Error Number, Error Description, Function/Sub-Routine Name, Module Name, Database Name).  The common error handler program will not only display the error message but also write out the details into a Text File on Disk.

If you have several Microsoft Access based Applications installed on Local Area Network all of them can save the error log information into a single text file on Server’s common location.  The error log will carry the Date, Time, Module Name and Database name, besides the normal error values Error Number and Error Description.

A Text file image with sample error log entries is given below:

The error log entry have all the details (Date & Time of Error, Database Path, Module Name, Procedure name etc. to pin-point the location of the Error.  Even if the user doesn’t bother to report the problem to the Administrator, the Administrator can periodically check this log file to monitor his application’s health.

The following sample data processing program DataProcess() attempts to open the input table Table_1, but the table doesn’t exist (got deleted or renamed by mistake) and the program runs into error:

Public Function DataProcess()
Dim db As Database, rst As Recordset, x
On Error GoTo DataProcess_Error

Set db = CurrentDb
Set rst = db.OpenRecordset("Table_1", dbOpenDynaset)

Do While Not rst.EOF
 x = rst.Fields(0).Value
Loop
rst.Close

DataProcess_Exit:
Exit Function

DataProcess_Error:
BugHandler Err, Err.Description, "DataProcess()", "Module4", CurrentDb.Name
Resume DataProcess_Exit
End Function

When the above program runs into error it calls the BugHandler() Program and passes the Module Name and Database Path as last two parameters in addition to Error Number, Error Description and Program name.  The VBA Code of BugHandler() main program is given below:

Public Function BugHandler(ByVal erNo As Long, _
                           ByVal erDesc As String, _
                           ByVal procName As String, _
                           ByVal moduleName As String, _
                           ByVal dbName As String)
On Error GoTo BugHandler_Error
Dim logFile As String
Dim msg As String

'Error Log text file pathname, change it to the correct path
'on your Local Drive or Server Location
logFile = "c:\mdbs\bugtrack\acclog.txt"

'Open log file to add the new error log entry
Open logFile For Append As #1
  'write the log details to log file
  Print #1, Now() & vbCr
  Print #1, "Database : " & dbName & vbCr
  Print #1, "Module   : " & moduleName & vbCr
  Print #1, "Procedure: " & procName & vbCr
  Print #1, "Error No.: " & erNo & vbCr
  Print #1, "Desc.    : " & erDesc & vbCr
  Print #1, String(80, "=") & vbCr
  Close #1

msg = "Procedure Name: " & procName & vbCr & "Error : " & erNo & " : " & erDesc
  MsgBox msg, , "BugHandler()"

BugHandler_Exit:
Exit Function

BugHandler_Error:
MsgBox Err & " : " & Err.Description, , "BugHandler()"
Resume BugHandler_Exit
End Function

You can save the above Code into a common Library Database, where you have saved your own common library functions, so that it can be attached to your Projects. 

This method will write out the details of errors from your databases into a common place accessible to you all the time.  When an Error is reported by the User you can directly check the details of it without asking the user to spell out.

• Creating Watermark on Reports
• Running Workgroup Admin in access2007
• Apply Filter to Table directly
• Dynamic Lookup in Query Column
• Creating Water-mark on Ms-Access Reports

For example, we have a Category Code Combo Box Field on the Form having values range from A to F. When the user selects one of this code from the Combo box the item Description Field’s Font Color should change as per the following color table:

Let us try this out on a sample Form.

1. Open a new Form in Design View.
2. Click on the Control Wizards button on the Toolbox to enable it.
3. Select the Combo box Tool and draw a Combo box in the Detail Section of the Form.
4. Select the Radio Button with the Caption: I will Type in the Values that I want then Click Next.
5. Type A, B, C, D, E & F in separate rows under Col1 and Click on Finish Command Button.
6. While the Combo box is still in selected state display the Property Sheet (F4).
7. Click on the Other Tab of the Property Sheet.
8. Change the Name Property Value to cboCat.
9. Select the Event Tab on the Property Sheet.
10. Select [Event Procedure] from the After Update Event Property.
11. Click on the Build (. . .) button at the right edge of the After Update Event property to open the VBA Module of the Form.
12. Copy and paste the following Code overwriting the empty lines of the After Update Event Procedure:

    Private Sub cboCat_AfterUpdate()
    Dim strtxt, num As Integer
    Dim colr As Long
    
    strtxt = Nz(Me![cboCat], "")
    If Len(strtxt) > 0 Then
      num = Asc(strtxt) - 64
    
      colr = Choose(num, 32768, 10485760, 16711680, 65280, 128, 255)
      With Me!Desc
         .ForeColor = colr
      End With
    
    End If
    End Sub

13. Close the VBA Editing Window to come back to the Form Design.
14. Create a Textbox to the right of the Combobox.
15. Display it’s Property Sheet (F4) and select the Other Tab.
16. Change the Name Property Value to Desc.
17. Save and Close the Form with the name Sample.
18. Open the Sample Form in Normal View.
19. Type your name in the Text box.
20. Try out our creation by selecting the Category Code (A,B,C,D,E,F) one after the other or in random order and watch the color of your name changes.

Change Secure DB to Unsecured

Date and Time Values

Limit to List Combo Box

Input Masks and Data Entry

For example, let us assume that we are creating a Mailing List of all Family members of all the residents in our locality and the sample data entry Form looks like the image given below:

^{Click to Enlarge the image}

If there are five members in a family then the data fields Family Code and Address line field values must be repeated for  each member of the family in next four records, as shown in the next image.  Only the unique information needs to be keyed in.

^{Click to Enlarge the image}

Let us try this out.

1. create a new Table with the following structure and save it with the name FamilyDetails:
   

   Table: FamilyDetails

   Srl	Field Name	Data Type	Field Size
   1	ID	AutoNumber
   2	FamilyID	Integer
   3	Title	Text	15
   4	FName	Text	25
   5	LName	Text	25
   6	Add1	Text	50
   7	Add2	Text	50
   8	City	Text	50
   9	State	Text	50
   10	Country	Text	50
   11	PIN	Text	10

2. Use the Form Wizard and create a Form in Column format, as shown in the image above, using the FamilyDetails Table and save the Form with the name frmFamilyDetails.
3. Create a Textbox (wide enough to type a list of field names separated with commas) on the header of the Form as shown in the image above.
4. Click on the Textbox to select it and display it’s Property Sheet (F4).
5. Change the Name Property Value to FieldList.
6. Create a Command Button below the Textbox, change it’s Name Property Value to cmdDup and change the Caption Property Value to Set Carry Forward.
7. Display the Form’s VBA Module (Design – - > Tools – - > View Code). Copy and paste the following Code into the Form Module and save the form:
   

   Private Sub cmdDup_Click()
   'Set 'CarryForward' Text in the submitted field's TAG property
   SetTagValue Me, "FieldList"
   
   End Sub
   
   Private Sub Form_AfterUpdate()
   'Set Default Property Value
   SetDefaultValue Me
   
   End Sub
   
   Private Sub Form_Current()
   'Change color of Duplicated field to Red.
   SetColorChange Me
   
   End Sub

8. Save and close the Form.
9. Open the VBA Editing Window (ALT+F11).
10. Create a new Standard Module (Insert – - > Module).
11. Copy and paste the following VBA Code (consisting of three Functions) into the new Module and save it:

    Public Function SetTagValue(ByVal frm As Form, ByVal fldList As String)
    '---------------------------------------------------------------------
    'Author: a.p.r. pillai
    'Date  : Feb 2012
    'Rights: All Rights Rserved by www.msaccesstips.com
    '---------------------------------------------------------------------
    Dim txt, splt, ctl As Control
    Dim ctlName As String, ctlType As Integer, j As Integer
    Dim resetFlag As Boolean, ctrl_name As String
    
    resetFlag = False
    txt = Nz(frm.Controls(fldList).Value, "")
    ctrl_name = frm.Controls(fldList).Name
    If Len(txt) = 0 Then
       resetFlag = True
    Else
       'split the field list sepparate with commas
       'and load them into the Array: splt()
       splt = Split(txt, ",")
    End If
    '   Set frm = Me
       'initialize all Textboxes and Combobox Tag & Default Value
       'Properties, except the FieldList textbox.
       'and change all field's Forecolor to black.
       For Each ctl In frm.Controls
          ctlType = ctl.ControlType
          ctlName = ctl.Name
          If ctlName = ctrl_name Then GoTo nextitem
    
          If ctlType = 109 Or ctlType = 111 Then
             ctl.Tag = ""
             ctl.DefaultValue = ""
             ctl.ForeColor = vbBlack
          End If
    nextitem:
       Next
    
       frm.Repaint 'show the change color on the form
       If resetFlag Then 'if the fieldlist textbox was empty then exit
         Exit Function
       End If
    
    'Compare each field's name on the form with the field names
    'selected and stored in the 'FieldList' Array.
       For Each ctl In frm.Controls
          ctlName = ctl.Name
          ctlType = ctl.ControlType
          'control-type 109 is Textbox and 111 is combobox
          'only these controls are duplicated
          If ctlType = 109 Or ctlType = 111 Then
             For j = 0 To UBound(splt)
                'if a match found then change it's Tag Property Value to 'CarryForward'.
                If Trim(splt(j)) = ctlName Then
                   ctl.Tag = "CarryForward"
                End If
             Next
    
          End If
       Next
    
    End Function
    
    Public Function SetDefaultValue(ByVal frm As Form)
    '---------------------------------------------------------------------
    'Author: a.p.r. pillai
    'Date  : Feb 2012
    'Rights: All Rights Rserved by www.msaccesstips.com
    'Run this Procedure when the Form_Update() Event Procedure fires.
    '---------------------------------------------------------------------
    Dim ctl As Control
    For Each ctl In frm.Controls
    If ctl.ControlType = 109 Or ctl.ControlType = 111 Then
          'if a control found with it's Tag Property set with the text 'CarryForward'
          'copy the current field value into the Default Property.
          'When the new record is created the Default Value will automatically
          'appear in the new record.
          If ctl.Tag = "CarryForward" Then
              ctl.DefaultValue = Chr$(34) & ctl.Value & Chr$(34)
    
          End If
               'change the color of the data to black
               ctl.ForeColor = vbBlack
    End If
    
    Next ctl
    frm.Repaint
    
    End Function
    
    Public Function SetColorChange(ByVal frm As Form)
    '---------------------------------------------------------------------
    'Author: a.p.r. pillai
    'Date  : Feb 2012
    'Rights: All Rights Rserved by www.msaccesstips.com
    'Note  : This Function is run from the Form_Current() Event Procedure.
    '---------------------------------------------------------------------
    
    Dim ctl As Control
    If frm.NewRecord Then
         For Each ctl In frm.Controls
             If ctl.ControlType = 109 Or ctl.ControlType = 111 Then
                'Format the copied values with Red Color.
                If ctl.Tag = "CarryForward" Then
                   ctl.ForeColor = vbRed
                End If
             End If
         Next
    frm.Repaint
    End If
    
    End Function

12. Open the FamilyDetails Form in Design View.
13. Key in your own personal information (or the sample data from the first image above), but don’t move to the next new record now.
14. Key in the following data field names into the text box ,in the header of the Form, separated with commas.

    
    FamilyID,Add1,Add2,City,State,Country,PIN
    

    Set the Child Labels of Text Boxes with the actual fields names (as shown in the above image) so that Users can type the required field names correctly from these labels.

15. Click on the Command Button.

    Note: The Command Button Click Event Procedure calls the SetTagValue() Function, with the Form object and the Textbox name: FieldList as parameters, that reads the Field List and records the text ‘CarryForward’ in each field’s Tag Property. Remember, we have not yet updated the current record into the Table.

16. Press Ctrl+S to update the current record and run the Form_AfterUpdate() Event Procedure that runs SetDefaultValue() function.

    Current record field (having their Tag Property set with the text ‘CarryForward’) values are copied into the Default Value Property of that field. The default values will appear in those fields in a new record automatically.

    Note: The Tag Property Value & Default Value are saving in those properties in Form View, not in design view. When you close the Form these settings are lost from these Properties. If you open the Form again you must specify the list of fields in the text box and click the Command Button to set the ‘CarryForward’ text in the Tag Property again.

    But, if you want certain fields to be assigned with permanent duplication feature on new records then open the form in design view and type the text CarryForward in the Tag Property manually and save the Form. In that case you don’t need the Text Box for the field list and Command Button on the header of the Form.

17. Press Ctrl++ to create a new record.

    The values we have saved in the Default Value Property (through the Form_AfterUpdate() event procedure) appears in the new record. The Form_Current() event procedure runs too and the color of the duplicated text changes to red. Now, all that left to do is to key in the rest of the information.

    The Ctrl+S first to update the current record and then the Ctrl+Plus next to create a new record steps we have taken only to explain what happens at each stage.

    After keying in the data on a record the User can directly press Ctrl+Plus (click on the New (Blank) Record control on the navigation control at the bottom of the form) to create a new record. This action will also fire the Form_AfterUpdate() event first and then the Form_Current() event next.

• Running Workgroup Admin in access2007
• Apply Filter to Table directly
• Dynamic Lookup in Query Column
• Creating Water-mark on Ms-Access Reports
• iSeries Date in exported Data

How do we take a print out of the current record on the Form?

Let us try this simple method to start with, before using the Form Filter on Report.  We need some sample data, a Form and a Report to try this out.

1. Import the Order details and Products Tables from the Northwind.accdb sample database.
2. Use the Report Wizard and design a Report using the Order Details Table as Record Source (sample report view is given below) and save the Report with the name Rpt_OrderDetails.

   

3. Use the Form Wizard and design a multiple items (continuous) Form using the Order Details Table (sample data view image is given below) and save it with the name Frm_OrderDetails.

   

4. Open the Form Frm_OrderDetails in design view.
5. Select the Command Button Tool from the Toolbox and draw a Command Button on the Header Section of the Form.
6. While the Command Button is still in selected state display the Property Sheet (Design – - >Tools – - > Property Sheet or use F4) and select All Tab on the Property Sheet.
7. Change the Name Property Value to cmdRpt and change the Caption Property Value to Run Report (see the Form image above).
8. Select the Event Tab of the Property Sheet.
9. Select [Event Procedure] from the drop-down list of the On Click event property and  click on the Build (. . .) button at the right edge of the property to open the VBA window with the skeleton of the Command Button Click Event Procedure.
10. Copy and paste the middle line of Code between the existing header and footer lines of the Command Button Click event procedure:

    
    
    Private Sub cmdRpt_Click()
    
       DoCmd.OpenReport "Rpt_OrderDetails", acViewPreview, , "[order id] = " & Me![order id]
    
    End Sub
    

    Check the middle line of the above code. The last parameter to the DoCmd.OpenReport command is a Filter condition to select the current record’s Order ID number to filter all records with the same Order ID number. We have inserted one extra comma between the printing option and the filter condition to skip the choice of using the name of a Query as Report Source Data.

    The filter condition "[Order Id] = " & Me![Order Id] states that take all the records with the current record Order ID Number as source data for the Report.

11. Save the form Frm_OrderDetails and open it in normal view
12. Click on any record with the same Order ID in more than one record or any record you like.
13. Click on the Run Report Command Button to open the Rpt_OrderDetails with the selected record.
14. Close the Report and you may try it again after selecting some other record on the Form.

The above example uses only a single record or several records with the same Order ID to print on the Report. 

Next, we will do it with more flexibility after setting the Filter Property Value of the Form. This can be done after selecting one or more Order IDs for filtering the data on the Form, before we open the Report for printing the data on the Form.  We must set a reference to the Filter Property of the Form replacing the criteria setting we have used earlier: "[order id] = " & Me![order id], on the DoCmd.OpenReport command.  

With this change the user can filter data based on any column value on the Form (like Order Id or Quantity or UnitPrice etc.) and use the result set to print the Report.

1. Make a copy of the form Frm_OrderDetails and paste it with the name Frm_Orderdetails2.
2. Open the form Frm_Orderdetails2 in design view.
3. Click on the Command Button to select and display it’s property sheet (F4).
4. Select  the Event Tab and select the On Click property.
5. Click on the Build (. . .) button to open the VBA window.
6. Copy the following Code and paste replacing the existing lines of code on the Form Module:

   Private Sub cmdRpt_Click()
       If Me.Filter = "" Then
           MsgBox "Apply a filter to the Form first."
       Else
           DoCmd.OpenReport "Rpt_OrderDetails", acViewPreview, , Me.Filter
       End If
   End Sub

7. Check the last parameter setting in the DoCmd.OpenReport statement. We are asking the Report to use whatever criteria setting is available in the current Form’s (Me) Filter Property Value (like ([Order Details].[Order ID] In (30,31,32))) to pick records for the Report. Save the Form and open it in normal view.
8. Click on the Command Button to open the Report.

   You will be greeted with a message asking to ‘Apply a filter to the Form first‘. When you click on the Command Button the program checks whether the Form’s Filter Property is set with a Filter condition or not, like the text we have used in the first example above, or like the sample shown in Step-7 above.

   Note: Remember, once you apply a filter on the form the text of the last filter condition remains saved on the Filter Property.  The Filter action is supported with another property value setting: FilterOn = True/False. When you Toggle the filter action on the Form the FilterOn property value changes but the Filter property value criteria text is not removed. You will be greeted with the above message only when the Filter Property Value is empty.

9. Click on the Order ID column on any record.
10. Click on the Filter Toolbar button (see the image below)to display the Filter selection control.

    

    A list of the selected field values (Order ID numbers) are displayed and shows all the values are check marked, indicating that all the values are in selected state.

11. Click on the Select All Option to de-select all the items.
12. Now, put check marks on the Order ID Numbers 30, 31 & 32 and Click OK to close the Filter Control.

    The form now shows only records of Order ID numbers 30, 31 & 32.

13. Click on the Run Report Command Button on the Header of the Form to open the Report in Print Preview with the records filtered on the Form.
14. Close the Report.
15. Place the cursor on the Quantity Field on any record on the Form.
16. Click on the Filter Toolbar Button to display the Filter Control.
17. Select the items with the Quantity values 100,200 & 300 and click OK button to close the control and filter the records you have selected.
18. Open the Report by clicking on the Run Report Command Button and check the report contents.
19. Close the Report.
20. Click on the Toggle Filter Toolbar button.  The Filter action is reversed and all the records are back on the Form (or the FilterOn Property Value is set as False now).
21. Now, Click on the Run Report Command Button to preview the Report. 

The Report shows the last filtered records only, rather than all the records from the Form.  When we toggle the filter Microsoft Access sets the FilterOn Property Value to False nullifying the effect of the filter action on the form, without removing the filter condition string inserted in the Filter Property, because the User may click the Toggle Filter button again to bring back data filtered by the last set filter condition. Our program keep using it because the Filter Property value is not empty and we are not checking the status of the FilterOn Property setting.

But, we can solve this issue with few changes in our program as follows:

Private Sub cmdRpt_Click()
    If Me.FilterOn Then
        DoCmd.OpenReport "Rpt_OrderDetails", acViewPreview, , Me.Filter
    Else
        DoCmd.OpenReport "Rpt_OrderDetails", acViewPreview
    End If
End Sub

Change the program as shown above and try the effect of the Filter and Toggle Filter action on the Form as well as on the Report.

• Apply Filter to Table directly
• Dynamic Lookup in Query Column
• Creating Water-mark on Ms-Access Reports
• iSeries Date in exported Data
• Change Query Top Values property with VBA

If all Invoices can be saved on disk in separate PDF Files then it is easy to send them through emails to the customers.  This will not only save the cost of stationery but also delivers the invoices to the customers’ mailbox instantly without delay.  Besides that customers can easily view the Invoices on their machines or take printouts at their end, if that become necessary.  In short, part of our tasks are passed on to the customers, saving our time and money.  I don’t think I can stretch it any more.

Let us try this with one or two Tables from the Northwind.mdb sample database.

1. Import the following Tables from the Northwind.mdb (or Access2007 Northwind.accdb) sample database:
   • Order Details
   • Products 

   NB: I will be using Tables from the Northwind.mdb database. But, the queries, Report and Code will be running under Access2007. The Products Table is not used directly in our Query or Report but the ProductID combobox in the Order Details table references this table for product description.

2. Open a new Query in SQL View without selecting any Table/Query from the displayed list.
3. Copy and Paste the following SQL string into the new Query’s SQL editing window and save the Query with the name Invoice_Orders_0:

   SELECT [Order Details].OrderID,
    [Order Details].ProductID,
    [Order Details].Quantity,
    [Order Details].UnitPrice,
    [Order Details].Discount,
    [Quantity]*((1-[Discount])*[UnitPrice]) AS TotalValue
   FROM [Order Details];

4. After saving and closing the above Query create another Query, using Invoice_Orders_0 as source, with the following SQL:

   SELECT Invoice_Orders_0.*
   FROM Invoice_Orders_0
   WHERE (((Invoice_Orders_0.OrderID)=10258));

5. Save the new Query with the name Invoice_Orders_1.
6. Design a Report to print Sales Invoice using Invoice_Orders_1 Query as Record Source.

   Sample Report Design Image is given below:

   

   Sample Report Preview Image is the next one:

   

7. Copy and paste the following VBA Code into a Standard Module and save it:

   Public Function Create_PDF(ByVal OrderStart As Integer, ByVal OrderEnd As Integer, ByVal strPath As String)
   '--------------------------------------------------------------------------------
   'Author : a.p.r. pillai
   'Date   : January 2012
   'Rights : All Rights(c) Reserved by www.msaccesstips.com
   '--------------------------------------------------------------------------------
   'Function Parameters:
   ' 1. - OrderID Start Number
   ' 2. - OrderID End Number
   ' 3. - Target Folder Address, sample: C:\My Documents
   '--------------------------------------------------------------------------------
   Dim strsql_1 As String, strsql As String, criteria As String
   Dim db As Database, rst As Recordset, QryDef As QueryDef
   Dim int_Order As Integer, outFile As String, T As Date
   Dim SQLParam As String, i As Integer, msg As String
   
   'Invoice Query Definition, Order Number must be added at the end as criteria
   strsql_1 = "SELECT Invoice_Orders_0.*  FROM Invoice_Orders_0 "
   strsql_1 = strsql_1 & " WHERE (((Invoice_Orders_0.OrderID)="
   
   'Query definition for Order Numbers between OrderStart and OrderEnd numbers
   SQLParam = "SELECT DISTINCT [Order Details].OrderID FROM [Order Details] "
   SQLParam = SQLParam & "WHERE ((([Order Details].OrderID) Between " & OrderStart & " And " & OrderEnd & ")) "
   SQLParam = SQLParam & " ORDER BY [Order Details].OrderID;"
   
   Set db = CurrentDb
   'open the OrderIDs parameter list to process one by one
   Set rst = db.OpenRecordset(SQLParam, dbOpenDynaset)
   'open the Report Query definition to incorporate OrderID criteria
   Set QryDef = db.QueryDefs("Invoice_Orders_1")
   
   i = 0 'take a count of invoices printed
   Do While Not rst.EOF 'cycle through the parameter list
     'get the order number
     int_Order = Nz(rst!OrderID, 0)
     If int_Order > 0 Then 'if any blank record ignore
        i = i + 1
        'create the criteria part for the Invoice Query
        criteria = int_Order & "));"
        'complete the Invoice SQL by adding the criteria.
        strsql = strsql_1 & criteria
        'Redefine the Invoice Query to print the Invoice
        QryDef.sql = strsql
        db.QueryDefs.Refresh
   
        'PDF file's target path and Order Number is the file name.
        outFile = strPath & "\" & int_Order & ".PDF"
   
        'Save the report as pdf file.
        DoCmd.OutputTo acOutputReport, "Rpt_Invoice", "PDFFormat(*.pdf)", outFile, False, "", 0, acExportQualityPrint
   
     '2 seconds delay loop to give enough time for Access to create the file on disk.
     T = Timer
     Do While Timer < T + 2
       DoEvents
     Loop
    End If
     rst.MoveNext
   Loop
   rst.Close
   
   msg = "Order Start Number: " & OrderStart & vbCr & vbCr
   msg = msg & "Order End Number: " & OrderEnd & vbCr & vbCr
   msg = msg & "Invoices Printed: " & i & vbCr & vbCr
   msg = msg & "Target Folder: " & strPath
   
   MsgBox msg, , "Create_PDF()"
   
   Set rst = Nothing
   Set db = Nothing
   Set QryDef = Nothing
   
   End Function

Now, let us take a look at what preparations we have made so far:

The first Query (Invoice_Orders_0) selects the required fields from Order Details Table for the Customer Invoice Report. Besides that it calculates the Total Value after Discount of each record in the Query. But, in this Query we have not set any criteria to select any specific OrderID  or Range of OrderIDs for printing the Invoices.

We are setting criteria to select specific OrderID in the second Query (Invoice_Orders_1),  created using the earlier Query (Invoice_Orders_0) as Source. The two step query simplifies the SQL and we must take the SQL into the VBA Code to redefine the Query, with changing OrderIDs, so that each OrderId level Invoice is saved in separate PDF file on Disk. 

We have one more Query (the third Query saved in SQLParam String Variable is used directly in the Set rst = db.OpenRecordset(SQLParam, dbOpenDynaset) statement) that is totally confined into the Create_PDF() Function.  When the Create_PDF() Function is called you must give the Order Start Number, Order End Number and Target Folder Address, where the PDF Files are to be saved, as function parameters. The third Query extracts all the Order Numbers within the Start Number and End Number range.  These will be taken one by one to print Invoices in individual files.

NB:  To make this sample exercise simple we are using only the transaction file to print the Invoices.  As you can see from the Report specimen shown above it doesn’t have any Customer Address printed on it.  If this is required then we must consider setting relationships with the Customer Address Table in the Report Query and include the address fields also. The main idea behind this whole exercise is to save the report of individual Invoices in separate pdf files, rather than going into its’ details or refinement.

Keeping that in focus let us continue to review what we are doing in the VBA Code lines.  You must call the Function using the following

Syntax:

Create_PDF  StartNumber,  EndNumber, ”PDF Files Target Folder”)

Example-1:

Create_PDF 10248,10265,”C:\My Documents”

 

Example-2:

 

x = Create_PDF(10248,10265,”C:\My Documents”)

 

You may call the function from a Command Button Click Event Procedure, after setting the Parameter values in Text Boxes on the Form

Example-3:

Create_PDF Me![txtSNumber], Me![txtENumber], Me![txtPathName]

With the Start Number and End Number values the Parameter Query is redefined to extract all the Order Numbers between those two numbers from the Order Details Table so that they can be used for extracting Order-wise items for printing individual Invoices.  The SELECT DISTINCT clause suppresses duplicates from the parameter list.

The data source of Rpt_Invoice Report is Invoice_Orders_1 Query. This is redefined for each OrderId as criteria for printing the Rpt_Invoice in PDF format.  The PDF files are saved in the location specified as third parameter C:\My Documents.

Each line in the VBA Code is commented to indicate what it does in each step, please go through them to understand the code better.

Key Words:PDF Files, Invoice, Report, Access2007

• Dynamic Lookup in Query Column
• Creating Water-mark on Ms-Access Reports
• iSeries Date in exported Data
• Change Query Top Values property with VBA
• Creating Animated Command Buttons
  Technorati Tags: Utility

What is the solution if we need different sequence numbers for the records that we create on each day?

For example, assume we are working on a Hospital Project and patients getting registered in the hospital on a particular day should have a unique Registration Card Number consisting of current date and a three digit sequence number in the format: yyyymmdd000. The sequence number must reset to 001 when the date changes.

If the Hospital maintains history records of the patients in physical files, organized by Date, Month and Year-wise order it is easy for them to locate any file with the Registraion Card Number.

We can generate this number automatically with a Function.  Let us try it with a sample Table and Form.

Before that copy and paste the following Function Code into a Standard VBA Module and save it:

Public Function Autonum(ByVal strField As String, ByVal strTable As String) As String
Dim dmval As String, dt1 As String, dt2 As String, Seq As Integer, dv As String

'get the highest existing value from the table
dmval = Nz(DMax(strField, strTable), 0)

'if returned value is 0 then the table is new and empty
'create autonumber with current date and sequence 001
If Val(dmval) = 0 Then
   dv = Format(Now(), "yyyymmdd") * 1000 + 1
   Autonum = dv
   Exit Function
End If

'format the number as an 11 digit number
dv = Format(dmval, "00000000000")
'take the 3 digit sequence number separately
Seq = Val(Right(dv, 3))
'take the date value separately
dt1 = Left(dv, 8)
'get today's date
dt2 = Format(Now(), "yyyymmdd")
'compare the latest date taken from the table
'with today's date
If dt1 = dt2 Then 'if both dates are same
   Seq = Seq + 1 'increment the sequence number
   'add the sequence number to the date and return
   Autonum = Format(Val(dt1) * 1000 + Seq)
   Exit Function
Else 'the dates are different
   'take today's date and start the sequence with 1
   Autonum = Format(Val(dt2) * 1000 + 1)
End If

End Function

1. Create a sample Table with the following Structure, as shown in the image given below:

   

2. The CardNo Field is a text type with 11 characters in length.  Both second and third fields are also text fields with sizes 10 and 50 characters respectively.
3. Save the Table with the name Patients.
4. Use the Form Wizard to design a Datasheet Form for the Patients Table and name the Form as frm_Patients.
5. Open the Form in Design View.
6. Click on the CardNo Field to select it.
7. Display the Property Sheet (F4). If you are using Access2007 then you can select CardNo from the Selection Type drop-down list.
8. Select the Data Tab and set the following Property Values as shown below:
   • Enabled = Yes
   • Locked = Yes
9. Access2007 users select Form from the Selection Type drop-down control. Earlier version users click on the top left corer of the Form (in the intersection where a black rectangle is shown) to ensure that the Property Sheet belongs to the Form and not of any other control on the Form.
10. Select the Event Tab on the Property Sheet.
11. Select the Before Insert  event property and select Event Procedure from the drop-down list.
12. Click on the Build (. . .) button to open the VBA Module of the Form.
13. Copy the middle line of the following procedure and paste it in the middle of the empty Form_BeforeInsert() lines of Code in the Form module.

    Private Sub Form_BeforeInsert(Cancel As Integer)
      Me![CARDNO] = Autonum("CardNo", "Patients")
    End Sub

14. Save the Form frm_Patients with the changes made.
15. Open the form in normal view and type Mr. in the Title Field and type some name in the Patient Name field.  You can see that the first field is filled with current date in yyyymmdd format and the sequence number 001 as suffix.
16. Type few more records.  Since, we have locked the CardNo field Users cannot edit this field’s contents. Sample image is given below:

1. Now, we will test whether the sequence number resets to 001 or not when the date changes. To do that first close the frm_Patients Form.
2. Open the Patients Table directly in Datasheet View.
3. Change the 7th and 8th digit from left (the dd digits of the date) to previous date in all the records that you have entered so far. 
4. For example: if the date displayed is 20120109001 then change it to previous day like: 20120108001.
5. When you have completed changing all the records close the Table.
6. Open the Form frm_Patients in normal view and try adding few more records on the Form. 

Tip:  If you prefer to test it on different dates on next few days you may do so rather than changing the dates and trying it now itself.

You can see that the Sequence number at the end of the CardNo resets to 001 with current date and subsequent records’ last three digits gets incremented automatically. 

The user cannot change the CardNo manually because we have set the Locked Property Value of the field to Yes.  Since, the Enabled Property Value also set to Yes the User can select this field and search for a specific CardNo, if needed.

If you would like to display the sequence number part separate from the date with a dash, (like: 20120109-005) we can do that by changing the Input Mask Property of the field, without affecting how it is recorded on the table.

1. Open the frm_Patients in Design View.
2. Click on the CardNo field to select it.
3. Display the Property Sheet (F4) of the Field.
4. Type 99999999-999;;_ in the Input Mask Property. 

   Tip: When you set the input mask this way the dash character between the date and sequence number is never stored in the table, it is used for display purposes only.  But, if you enter a 0 between the two semi-colons like 99999999-999;0;_ then the dash character also will be stored in the CardNo field on the table.  It is better if we don’t do that.

5. Save the Form and open it in normal view.  Now you can distinguish the date and sequence number very easily.

Assume that a Patient approaches the registration desk with her Registration Card, the staff member at the desk should search for the patient’s record with the CardNo to retrieve her history record, to know the location of her personal file, to know which doctor the patient attended last etc.  You have two search options when the search control is displayed. 

Try the following:

1. Click on the CardNo field to select it.
2. Press Ctrl+F to display the search control (search control image is given below).

As shown on the image above you can search for the CardNo without the dash if you remove the check mark from the search option Search Field as Formatted.  Put the check-mark on when searched with the dash separating date and sequence number.

• Creating Water- mark on Ms-Access Reports
• iSeries Date in exported Data
• Change Query Top Values property with VBA
• Creating Animated Command Buttons
• Data Change Monitoring

Before running that function the user has to spot some text to search for and then run the function with that search text as parameter. The utility function searches for the text, with .Find() method of the Module Object, to find the search text and select that line within the target Function/Sub-Routine.  Based on the selected line we can read other details of the function/sub-routine, like total number of lines within that function/sub-routine, function header line number and function ending line number.  These parameters must be available to insert the error handling lines in appropriate locations within the procedure.

If there are several functions or sub-routines to insert error handling lines then this method takes some time to cover all of them, one by one.

Here, we will look at a different version of the same function that scans through the entire Module and inserts error handling lines in all of the Functions/Sub-Routines at one go.

Before that,

Links to the earlier Articles are given below, just in case if you would like to take a look at the simple methods of the Module Object we have tried earlier:

Write VBA Code with VBA

VBA Module Object and Methods

Prepare a list of Procedure Names from a Module

Utility for inserting VBA Error Handler Code

The new function is much simpler to use.  Copy and paste the following Code into a new Standard Module and save it:

Public Function ErrorTrap(ByVal str_ModuleName As String)
On Error GoTo ErrorTrap_Error
'--------------------------------------------------------------
'Program : Inserting Error Handler Lines automatically
'        : in a VBA Module
'Author  : a.p.r. pillai
'Date    : December, 2011
'Remarks : All Rights Reserved by www.msaccesstips.com
'--------------------------------------------------------------
'Parameter List:
'1. strModuleName - Standard Module or Form/Report Module Name
'--------------------------------------------------------------

Dim objMdl As Module, x As Boolean, h As Long, i As Integer
Dim w As Boolean, lngR As Long, intJ As Integer, intK As Integer
Dim linesCount As Long, DeclLines As Long, lngK As Long
Dim str_ProcNames(), strProcName As String, strMsg As String
Dim start_line As Long, end_line As Long, strline As String
Dim lng_StartLine As Long, lng_StartCol As Long
Dim lng_EndLine As Long, lng_EndCol As Long, procEnd As String
Dim ErrHandler As String, lngProcLineCount As Long
Dim ErrTrapStartLine As String, lngProcBodyLine As Long

Set objMdl = Modules(str_ModuleName)

linesCount = objMdl.CountOfLines
DeclLines = objMdl.CountOfDeclarationLines
lngR = 1
strProcName = objMdl.ProcOfLine(DeclLines + 1, lngR)
If strProcName = "" Then
   strMsg = str_ModuleName & " Module is Empty." & vbCr & vbCr & "Program Aborted!"
   MsgBox strMsg, , "ErrorTrap()"
   Exit Function
End If
strMsg = strProcName
intJ = 0

'Determine procedure Name for each line after declaraction lines
For lngK = DeclLines + 1 To linesCount

  'compare procedure name with ProcOfLine property
  If strProcName <> objMdl.ProcOfLine(lngK, lngR) Then
     'increment by one
     intJ = intJ + 1
     'get the procedure name of the current program line
     strProcName = objMdl.ProcOfLine(lngK, lngR)
  End If
Next lngK

ReDim str_ProcNames(intJ)

strProcName = strMsg: intJ = 0
str_ProcNames(intJ) = strProcName
For lngK = DeclLines + 1 To linesCount
  'compare procedure name with ProcOfLine property

  If strProcName <> objMdl.ProcOfLine(lngK, lngR) Then
     'increment array index by one
     intJ = intJ + 1
     'get the procedure name of the current program line
     strProcName = objMdl.ProcOfLine(lngK, lngR)
     str_ProcNames(intJ) = strProcName

  End If
Next

For intK = 0 To intJ
    ErrHandler = ""
    ErrTrapStartLine = ""
    'Take the total count of lines in the module including blank lines
    linesCount = objMdl.CountOfLines

    strProcName = str_ProcNames(intK) 'copy procedure name
    'calculate the body line number of procedure
    lng_StartLine = objMdl.ProcBodyLine(strProcName, vbext_pk_Proc)
    'calculate procedure end line number including blank lines after End Sub
    lng_EndLine = lng_StartLine + objMdl.ProcCountLines(strProcName, vbext_pk_Proc) + 1

    lng_StartCol = 0: lng_EndCol = 150
    start_line = lng_StartLine: end_line = lng_EndLine

    'Check for existing Error Handling lines in the current procedure
    x = objMdl.Find("On Error", lng_StartLine, lng_StartCol, lng_EndLine, lng_EndCol)
    If x Then
         GoTo NxtProc
    Else
     'Create Error Trap start line
         ErrTrapStartLine = "On Error goto " & strProcName & "_Error" & vbCr
    End If

    ErrHandler = vbCr & strProcName & "_Exit:" & vbCr

    lngProcBodyLine = objMdl.ProcBodyLine(strProcName, vbext_pk_Proc)

    'Set procedure start line number to Procedure Body Line Number
    lng_StartLine = lngProcBodyLine
    'calculate procedure end line to startline + procedure line count + 1
    lng_EndLine = lng_StartLine + objMdl.ProcCountLines(strProcName, vbext_pk_Proc) + 1

    'Save end line number for later use
    'here lng_endline may include blank lines after End Sub line
    lngProcLineCount = lng_EndLine

    'Instead of For...Next loop we could have used the .Find() method
    'but some how it fails to detect End Sub/End Function text
    For h = lng_StartLine To lng_EndLine
      strline = objMdl.Lines(h, 1)
      i = InStr(1, strline, "End Sub")
      If i > 0 Then
          'Format Exit Sub line
          ErrHandler = ErrHandler & "Exit Sub" & vbCr & vbCr
          lngProcLineCount = h 'take the correct end line of End Sub
          h = lng_EndLine + 1
          GoTo xit
      Else
         i = InStr(1, strline, "End Function")
         If i > 0 Then
          'Format Exit Function line
          ErrHandler = ErrHandler & "Exit Function" & vbCr & vbCr
          lngProcLineCount = h 'or take the correct endline of End Function
          h = lng_EndLine + 1
          GoTo xit
        End If
      End If
xit:
    Next

   'create Error Handler lines
   ErrHandler = ErrHandler & strProcName & "_Error:" & vbCr
   ErrHandler = ErrHandler & "MsgBox Err & " & Chr$(34) & " : " & Chr$(34) & " & "
   ErrHandler = ErrHandler & "Err.Description,," & Chr$(34) & strProcName & "()" & Chr$(34) & vbCr
   ErrHandler = ErrHandler & "Resume " & strProcName & "_exit"

  'Insert the Error catch start line immediately below the procedure header line
   objMdl.InsertLines lngProcBodyLine + 1, ErrTrapStartLine

 'Insert the Error Handler lines at the bottom of the Procedure
 'immediately above the 'End Function' or 'End Sub' line
   objMdl.InsertLines lngProcLineCount + 2, ErrHandler

NxtProc:
Next

strMsg = "Process Complete." & vbCr & "List of Procedures:" & vbCr
For intK = 0 To intJ
  strMsg = strMsg & "  *  " & str_ProcNames(intK) & "()" & vbCr
Next
MsgBox strMsg, , "ErrorTrap()"

ErrorTrap_Exit:
Exit Function

ErrorTrap_Error:
MsgBox Err & " : " & Err.Description, , "ErrorTrap()"
Resume ErrorTrap_Exit
End Function

You can run this function from the Debug Window or from a Command Button Click Event Procedure.  Sample run Syntax on Standard Module:

ErrorTrap “Module Name”

Example-1:

ErrorTrap "Module3"

Module3 will be scanned for Procedure Names and each procedure is checked for the presence of existing Error Handling lines.  If ‘On Error Goto’ statement is encountered anywhere within a procedure then that procedure is skipped and goes to the next one to check.

To run on Form or Report Module use the following Syntax:

ErrorTrap "Form_FormName"

Example-2:

ErrorTrap "Form_Employees"

Example-3:

ErrorTrap "Report_Orders"

When the ErrorTrap() function completes working with a module it displays the list of procedures found in that Module. Sample run image is given below:

If you run the ErrorTrap() Program on a Form/Report that doesn’t have a VBA Module ( or its Has Module Property value is set to No) then a Subscript out of Range message is displayed and the program will be aborted.

It is better if you save this Program in your Library Database and link the Library Database to your Project.  Visit the Link: Command Button Animation for details on how to use a database as a Library Database with your own Custom Functions.

I tried to take the ErrorTrap() Function one step further to scan through the entire database Modules and insert error trap routines in all of them, saving each module immediately after changes.  But, Access2007 keep crashing every time and finally I have discarded the idea.  Besides, the above function gives the User more control to review the module subjected to this function for any kind of side effects.

I have test run this function several times and found ok, but field testing may be required under different environment to detect logical errors.  If you find any such errors please give me a feed back through the comment section of this page.  Review each module immediately after running this function for accuracy and use it at your own risk. 

• iSeries Date in exported Data
• Change Query Top Values property with VBA
• Creating Animated Command Buttons
• Data Change Monitoring
• Continued on Page-2 on Report

Now, we are going to write a very useful Utility Program for inserting general Error Handler Code Lines into VBA Functions or Sub-Routines automatically. Let us take a look at the Error Trap Routine that we normally write in a Sub-Routine to take care of unexpected errors and to exit the program gracefully, without stopping the code and giving trouble to the User in the middle of normal operations.

Private Sub cmdRunReport_Click()
On Error Goto cmdRunReport_Click_Error
.
.
.
.
cmdRunReport_Click_Exit:
Exit Sub

cmdRunReport_Click_Error:
MsgBox Err & " : " & Err.Description,,"cmdRunReport_Click()"
Resume cmdRunReport_Click_Exit

End Sub

The blue colored lines are the Error Handler Lines and the dotted area will hold the actual program.  Normally, we concentrate on writing code for the actual action we intended to execute within the procedure (the dotted line area) and the Error Handler part can wait for later finishing touches stage.  File handling programs or areas where validation checks are performed gets more attention in setting up error trap routines.

Our idea is to insert the Error Handler lines at the beginning and end of the program automatically.  Any serious program that you will write needs these lines of code and writing them manually everywhere will take some of your valuable time in a busy schedule.  If you left out some of your programs without adding the Error Handler lines earlier, you can add them now very easily with the Utility Program that we are going to write.

As you can see in the above code that the lines suffixed with _Exit:, _Error: etc. have the program name attached to them like cmdRunReport_Click_Exit: and these values are taken from the Sub-Routine or Function Names.  The first line of the error handler will be inserted immediately after the Program Name and other lines at the end of the Program.  So we must know few details about the program before we are able to insert the Error Trap Lines into appropriate locations in the program.  For that we must address few Property Values of any line of code located within the Function or Sub-Routine and get the property values from the Module Object.

To make it more clear let us draw out a plan for our program as below:

1. First, search for some unique text within the VBA Module, located within our target Function or Sub-Routine.  For this we can use the .Find() method of the Module Object.
2. Once the search stops on the target line within the Function or Sub-Routine we can read several details of the program we are in now.  The .Find() method not only finds the target line of our program with the search text but also the program line number within the Module (all the lines within a Module is sequentially numbered including blank lines), the Column Number at which the search text starts, which column the search text ends etc.  The Find() method Syntax is as given below:

Modules(ModuleName).Find strSearchText, lngStart_Line, lngStart_Column, lngEnd_line, lngEnd_Column, [[WholeWord], [MatchCase], [PatternSearch]]

Sample Code:

Set mdl = Modules("Form_Employees")

With mdl
  .Find “myReport”, lngStart_Line, lngStart_Column, lngEnd_line, lngEnd_Column, False
End With

• The first parameter is the search text to find.
• The next four parameters tells from where to start and where to stop looking for the search text.  For example, you want to search for the second occurrence of the text “myReport” located somewhere beyond line number 25 then you will set lngStart_Line=25.  If “myReport” is in Docmd.OpenReport “myReport” then the lngStart_Column value can be about 10 or leave it as 0 to start searching from beginning of the line.  Once the search text is located by the Find() method all four variables will be loaded with the search text related values as below:
  • lngStart_Line = line number on which the search text is located.
  • lngStart_Column = Column Number (or first character of the search text starts on which character position from left)
  • lngEnd_Line = Line on which the Search Text found and search stoped.
  • lngEnd_Column = Column on which the search text ends.
• Once the search text is located on a line the lngStart_Line and lngEnd_line will refer to the same program line on which the search text is located.  The start and end column values will be loaded into lngStart_Column and lngEnd_Column variables.
• When the search operation is successful we can extract several information related to that program line to use for working within that particular Function or Sub-Routine. We will read the following information of a particular program to insert the Error Handler lines of Code at appropriate locations in the Program:
  • Get the Program Name from the .ProcOfLine Property (or in expanded form Procedure name Of the Line we found through search) of the program line.
  • Get the Procedure Body Line Number from the .ProcBodyLine Property. The line number on which the program Private Sub cmdRunReport_Click() starts. This line number + 1 is the location where we can insert the first line (On Error Goto label statement) of Error Handler.
  • Get the Number of Lines in this particular procedure we are in, from .ProcCountLines Property.  Even though this is a useful information this has some draw backs.  If there are blank lines above the procedure Name or below the End Sub or End Function line (if it is the last procedure in a Module then it can have blank lines at the end) they are also included in the count.  So we must take corrective action or take alternative measures to take correct values.
• Once the above information is available we can write the Error Handler lines into String Variables and use the .InsertLines() method of the Module Object to place them in the beginning and end of the procedure.

1. Open the VBA Editing Window (ALT+F11).
2. Insert a new Standard Module.
3. Copy and Paste the following VBA Code into the Module and Save it:

Public Function ErrorHandler(ByVal strModuleName As String, _
                                ByVal strSearchText As String, _
                                Optional ByVal lng_StartLine As Long = 1)
On Error GoTo ErrorHandler_Error
'--------------------------------------------------------------------------------
'Program : Inserting Error Handler Lines automatically
'        : in VBA Functions or Sub-Routines
'Author  : a.p.r. pillai
'Date    : December, 2011
'Remarks : All Rights Reserved by www.msaccesstips.com
'--------------------------------------------------------------------------------
'Parameter List:
'1. strModuleName - Standard Module or Form/Report Module Name
'2. strSearchText - Text to search for within a
'   Function or Sub-Routine
'3. lng_StartLine - Text Search Start line Number, default=1
‘Remarks: Standard/Form/Report Module must be kept open before running this Code
'--------------------------------------------------------------------------------
Dim mdl As Module, lng_startCol As Long
Dim lng_endLine As Long, lng_endCol As Long, x As Boolean, w As Boolean
Dim ProcName As String, lngProcLastLine As Long
Dim ErrTrapStartLine As String, ErrHandler As String
Dim sline As Long, scol As Long, eline As Long, ecol As Long
Dim lngProcBodyLine As Long, lngProcLineCount As Long
Dim lngProcStartLine As Long, start_line As Long, end_line As Long

Set mdl = Modules(strModuleName)
lng_startCol = 1
lng_endLine = mdl.CountOfLines
lng_endCol = 255

With mdl
    .Find strSearchText, lng_StartLine, lng_startCol, lng_endLine, lng_endCol, False
End With

'lng_StartLine - line number where the text is found
'lng_StartCol  -  starting column where the text starts
'lng_EndCol    - is where the search text ends
'lng_EndLine   - end line where the text search to stop
'if search-text is found then lng_StartLine and lng_EndLine will
'point to the same line where the search-text is found
'otherwise both will be zero

If lng_StartLine > 1 Then
  'Get Procedure Name.
  'The vbext_pk_Proc system constant
  'dictates to look within a Function or Sub Routine
  'Not to consider Property-Let/Get etc.
   ProcName = mdl.ProcOfLine(lng_endLine, vbext_pk_Proc)

   'Get Procedure Body Line Number
   lngProcBodyLine = mdl.ProcBodyLine(ProcName, vbext_pk_Proc)

   'Look for existing Error trap routine, if any
   'if found abort the program
   sline = lngProcBodyLine: scol = 1: ecol = 100: eline = lng_endLine
   x = mdl.Find("On Error", sline, scol, eline, ecol)
   If x Then
      MsgBox "Error Handler already assigned, program aborted"
      Exit Function
   End If

 'Get Line Count of the Procedure, including
 ' blank lines immediately above the procedure name
 'and below, if the procedure is the last one in the Module
   lngProcLineCount = mdl.ProcCountLines(ProcName, vbext_pk_Proc)

 'Create Error Trap start line
   ErrTrapStartLine = "On Error goto " & ProcName & "_Error" & vbCr
 'Compose Error Handler lines
   ErrHandler = vbCr & ProcName & "_Exit:" & vbCr

'determine whether it is a Function procedure or a Sub-Routine
'lng_StartLine = lng_endLine:
lng_startCol = 1: lng_endCol = 100: lng_endLine = lngProcBodyLine + lngProcLineCount
'save the startline and lng_EndLine values
start_line = lng_StartLine: end_line = lng_endLine

'Check whether it is a Function Procedure or a Sub-Routine
w = mdl.Find("End Function", lng_StartLine, lng_startCol, lng_endLine, lng_endCol, False)

If w Then 'Function Procedure
   'Take correct procedure line count excluding
   'blank lines below End Sub or End Function line
   lngProcLineCount = lng_StartLine
   ErrHandler = ErrHandler & "Exit Function" & vbCr & vbCr
Else
   lng_StartLine = start_line: lng_endLine = end_line: lng_startCol = 1: lng_endCol = 100
   w = mdl.Find("End Sub", lng_StartLine, lng_startCol, lng_endLine, lng_endCol, False)
   If w Then 'Sub-Routine
     lngProcLineCount = lng_StartLine
     ErrHandler = ErrHandler & "Exit Sub" & vbCr & vbCr
   End If
End If
   'create Error Handler lines
   ErrHandler = ErrHandler & ProcName & "_Error:" & vbCr
   ErrHandler = ErrHandler & "MsgBox Err & " & Chr$(34) & " : " & Chr$(34) & " & "
   ErrHandler = ErrHandler & "Err.Description,," & Chr$(34) & ProcName & "()" & Chr$(34) & vbCr
   ErrHandler = ErrHandler & "Resume " & ProcName & "_exit"

  'Insert the Error catch start line immediately below the header line
   mdl.InsertLines lngProcBodyLine + 1, ErrTrapStartLine

 'Insert the Error Handler lines at the bottom of the Procedure
 'immediately above the 'End Function' or 'End Sub' line
   mdl.InsertLines lngProcLineCount + 2, ErrHandler

End If

ErrorHandler_Exit:
Exit Function

ErrorHandler_Error:
MsgBox Err & " : " & Err.Description, , "ErrorHandler()"
Resume ErrorHandler_Exit

End Function

Since, this program itself is a Coding aide you must keep the target Module (Standard/Form/Report) open before running this program to insert the Error Handling code segment into the target Function/Sub-Routine.

You may call the ErrorHandler() Function from the Debug Window or from a Command Button Click Event Procedure as shown below:

'The third parameter is optional, you may omit it
ErrorHandler "Form_Employees","myReport",1

This will start searching for the text myReport from the beginning of the Employees Form Module, stops within the program where the search finds a text match and inserts the Error Handling Code lines at the beginning and end of the program.

If the text ‘myReport’ appears in more than one Function/Sub-Routine in the Module then you must give the third parameter (Search start line number) to start searching for the text beyond the area wherever exclusion is required. Example:

'Look for text 'myReport' from line 20 onwards only
ErrorHandler "Form_Employees","myReport",20

When the ErrorHandler() Function is run, first it will look for the presence of existing error handling lines starting with ‘On Error’ and if found assumes that the error handling lines are already present in the Function/Sub-Routine and stops the program after displaying the following message:

‘Error Handler already assigned, program aborted.’

Comment lines are added for clarity above the program lines explaining what happens next. 

If you find any logical error in the program please give me feed back through the comment section of this page. To protect from spam we insist on joining the site before you are able to post comments.

• Change Query Top Values property with VBA