Microsoft Access VBA Tutorials for self-paced learning, Class Modules, SQL Techniques, and AI Integration Guides.

Showing posts with label Utilities. Show all posts
Showing posts with label Utilities. Show all posts

Uploading Comma delimited Text Data into Access Table-2

Introduction.

Last week, we learned how to upload a simple list of names (separated with commas) from a text file into a Microsoft Access Table.

Next, we will enhance the program to include additional fields—Name, Birthdate, Height, and Weight—for each record.

For reference, a sample of the text file layout is shown in the image below.

The text file contains a fixed number of items per line, with all four items for a single record. In last week’s example, we used only one column in the Access table output, and the number of items on each line varied.

Since all items are written to a single output column in the Access table, we need to determine how many elements exist in the x_Names array, which is created using the Split() function from a single line of text. We use the UBound() function to get the count of items in the array before processing them.

In this example, we have an output table with a fixed number of fields: Name, Birth Date, Height, and Weight. A sample image of the output table is given below:


The VBA Code.

VBA Code that uploads the text file into the Access table is given below:

Public Function NamesList2()
'-----------------------------------------------------
'Utility: Creating Access Table from
'       : comma separated text data.
'Author : a.p.r.pillai
'Date   : May 2016
'Rights : All Rights Reserved by www.msaccesstips.com
'-----------------------------------------------------
Dim db As Database, rst As Recordset, tdef As TableDef
Dim strH As String, fld As Field, j As Integer
Dim x_Names As Variant, tblName As String, fldName As String
Dim txtfile As String

On Error GoTo NamesList2_err
tblName = "NamesList2"
txtfile = "d:\mdbs\Names2.txt" 'Make required changes 

'create the NamesList2 table
Set db = CurrentDb
Set tdef = db.CreateTableDef(tblName)
With tdef
  .Fields.Append .CreateField("Name", dbtext, 50)
  .Fields.Append .CreateField("BirthDate", dbDate)
  .Fields.Append .CreateField("Height", dbInteger)
  .Fields.Append .CreateField("Weight", dbInteger)
End With
db.TableDefs.Append tdef
db.TableDefs.Refresh

'Open the NamesList table to write names with the text file
Set rst = db.OpenRecordset(tblName)

'Open the Names2.txt file to upload data into the table
Open txtfile For Input As #1
'setup a loop to read the data till the end-of-file reached
Do While Not EOF(1)
'read the first line of items separated with commas and
'terminated with carriage return (Enter key)into variable strH
Line Input #1, strH
'extract each item separated with comma and load into the Array variable x_Names
x_Names = Split(strH, ",")

'Read each item from array elements
'and write into the NamesList2 table fields
With rst
    .AddNew
    ![Name] = x_Names(0)
    ![BirthDate] = x_Names(1)
    ![Height] = x_Names(2)
    ![Weight] = x_Names(3)
    .Update

End With
'Repeat till the End-Of-Text File is reached
Loop

NamesList2_Exit:
rst.Close
db.Close
Set rst = Nothing
Set db = Nothing
Exit Function

NamesList2_err:
If Err = 3010 Then 'Table already exists
  'continue executing from the next line onwards
  Resume Next
Else
  MsgBox Err & ": " & Err.Description, "NamesList2()"
  Resume NamesList2_Exit
End If
End Function

How IT Works.

As in the previous example, we first attempt to create a new Access table with four fields. If the table creation process returns error code 3010, it means the table already exists, and the program skips the table creation step and continues execution. Any other error code will cause the program to terminate.

Next, the text file is opened for reading, processing one line at a time. The Split() function breaks each line into individual items and stores them in the x_Names array.

The following step is to add a new record to the Access table. Each item from the array is assigned to its corresponding field before the record in the table is updated. Since each line contains four items in a fixed order, we only need to know the array index numbers to correctly assign them:

  • x_Names(0) → Name

  • x_Names(1) → Birth Date

  • x_Names(2) → Height

  • x_Names(3) → Weight

Remember, the Split() function uses a zero-based index, so the array elements are numbered 0, 1, 2, 3 in memory, corresponding to each item in the line. The program snippet below demonstrates this process.

With rst
    .AddNew
    ![Name] = x_Names(0)
    ![BirthDate] = x_Names(1)
    ![Height] = x_Names(2)
    ![Weight] = x_Names(3)
    .Update

End With

We can use the following code in place of the above code snippet:

With rst
    .AddNew
For j = 0 To UBound(x_Names)
    
    .Fields(j).Value = x_Names(j)
    
Next
    .Update
End With

The first code snippet is beginner-friendly and easy to understand. However, it becomes less efficient when there are more items on a line to upload.

The second code snippet is more compact and does not reference field names directly. This has two advantages:

  1. If any field names change later, the first snippet may generate an error, whereas the second snippet will continue to work without modification.

  2. The second snippet automatically handles any number of items on a line, making it more flexible and scalable for larger datasets.

The first code cannot be used for a different table, but the second code snippet works for any table without change.

Share:

Uploading Comma Separated Text Data into Access Table

Introduction.

Converting the contents of an Access table into a comma-delimited text file (CSV format) makes it easier to transport data over the Internet. Such files can be uploaded back into an Access table or imported into virtually any other database system at the receiving end.

We have already explored the data exporting procedure in an earlier example. You can refer to that discussion, which also demonstrates the use of Access’s GetRows() function. This function efficiently copies the entire table contents into a two-dimensional array in memory with a single operation, making it an excellent tool for preparing data for export. 

Microsoft Access already has built-in data Import and Export options.

Here, we will learn how to read a Text File containing the names of Employees, each separated by a comma, and write them into a new Access table. An Image of a sample text file is given below:

An Image of the output Access Table, with a single column, is given below for reference.

  1. First, create a text file using Notepad or any other text editor, and enter some sample data. Each line should contain a few names (people or products) separated by commas. Place each set of items on a new line, as shown in the earlier example.

    ⚠️ Important: Do not put a comma at the end of any line.

  2. Save the Text file with the name: Names.txt, in your database folder, or in any folder you like.

  3. Open your Access Database to try out the Program given below.

  4. Open the VBA Editing Window and insert a new Standard Module.

  5. Copy and paste the following VBA Code into the Module and save it:

    Creating a Table From Comma-Separated Text File.

    Public Function NamesList()
    '-----------------------------------------------------
    'Utility: Creating Access Table from
    '       : comma separated text data.
    'Author : a.p.r.pillai
    'Date   : April 2016
    'Rights : All Rights Reserved by www.msaccesstips.com
    '-----------------------------------------------------
    Dim db As Database, rst As Recordset, tdef As TableDef
    Dim strH As String, fld As Field, j As Integer
    Dim x_Names As Variant, tblName As String, fldName As String
    Dim txtfile As String
    
    On Error GoTo NamesList_err
    
    tblName = "NamesList"
    fldName = "Names"
    txtfile = "d:\mdbs\Names.txt" 'Change this line to correctly point where your text file is saved.
    
    'create the NamesList table with a single field: Names
    Set db = CurrentDb
    Set tdef = db.CreateTableDef(tblName)
    With tdef
      .Fields.Append .CreateField(fldName, dbtext, 50)
    End With
    db.TableDefs.Append tdef
    db.TableDefs.Refresh
    
    'Open the NamesList table to write names with the text file
    Set rst = db.OpenRecordset(tblName)
    
    'Open the Names.txt file to read text data
    Open txtfile For Input As #1
    'setup a loop to read the data till the end-of-file reached
    Do While Not EOF(1)
    'read the first line of names, separated with commas and
    'terminated with carriage return (Enter key),into String variable strH
    Line Input #1, strH
    'extract each name separated with comma and load into the Array variable x_Names
    x_Names = Split(strH, ",")
    
    'Read each name from array elements
    'and write into the NamesList table
    With rst
    For j = 0 To UBound(x_Names)
        .AddNew
        !Names = x_Names(j)
        .Update
    Next
    End With
    'Repeat till the End-Of-Text File is reached
    Loop
    close #1
    
    NamesList_Exit:
    rst.Close
    db.Close
    Set rst = Nothing
    Set db = Nothing
    Exit Function
    
    NamesList_err:
    If Err = 3010 Then 'Table already exists
      'continue executing from the next line onwards
      Resume Next
    Else
      MsgBox Err & ": " & Err.Description, "NamesList()"
      Resume NamesList_Exit
    End If
    End Function
  6. Find this line in the vba code: txtfile = "d:\mdbs\Names.txt" and make the change in the correct location of your text file. Click somewhere in the middle of the Code and press the F5 Key to run the Code.

    Note: If everything went well, then you will find the Table Names list in the Navigation Pane. If you could not find it, then right-click on the top bar of the Navigation Pane and select Search Bar. Type NamesList in the Search Bar to bring up the table in view. Click on it to open and view the data.

How This Works.

  • When the program runs for the first time, it creates the NamesList Table, with a single field: Names. Subsequent runs of the program ignore the table creation action and simply append the data to the existing table from the text file.

  • The program reads the first text line (for example, three names separated by commas) into the string variable strH.

    We use the Line Input statement here instead of the Input statement.

    • Line Input reads the entire line of text, stopping only when it encounters a carriage return (the Enter key at the end of the line).

    • Input, on the other hand, treats the comma as a delimiter. So, it would only read the first name and stop at the comma, ignoring the rest of the line.

  • The Split() Function will break up the names separately and load them into the Variant Array Variable: x_Names.

  • The Array variable x_Names will be automatically dimensioned/re-dimensioned by the Split() Function, for the number of items on the input line, and each item is loaded into the elements of the array.

  • In the next step, a new record is added to the Access Table for each item loaded into the array and written to the table from the array elements.

  • This process is repeated for all the lines in the text file. When the end of the text file is reached, all files are closed, and the function stops.

Next week, we will learn how to work with text files that have several fields of data in a record.

Share:

Appending Data from Excel to Access

Introduction

Last week, we tried out an interesting method of writing a range of Excel data directly into a Microsoft Access Table. Each row of cells is transferred into the table as a single record. If you haven't come across that article, then you may find it here.

This is an equally interesting method.  The selected Worksheet contents are appended to the Access Table with its specified columns in the SQL.

A sample image of the Worksheet data is given below:


The VBA Code

Private Sub CommandButton1_Click()
On Error GoTo CommandButton1_Click_Error
'Create Database connection Object
Set cn = CreateObject("ADODB.Connection")
'Access Database must be in the same location of the Worksheet 
dbpath = Application.ActiveWorkbook.Path & "\Database4XL.accdb"
'Get Workbook Full Pathname
dbWb = Application.ActiveWorkbook.FullName
'Get Active worksheet name
dbWs = Application.ActiveSheet.Name
'Create Data Target Connection string to open a session for data transfer
scn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbpath
'Datasheet name to add at the end of the Workbook Name, to complete the
'FROM clause of the SQL String.
dsh = "[" & dbWs & "$]"
'Open session
cn.Open scn

'Append Query SQL String
ssql = "INSERT INTO Table1 ([Desc], [Qrtr1], [Qrtr2], [Qrtr3], [Qrtr4]) "
ssql = ssql & "SELECT * FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh

'Run SQL
cn.Execute ssql

MsgBox "Data Added to " & dbpath & " Successfully."

CommandButton1_Click_Exit:
Exit Sub

CommandButton1_Click_Error:
MsgBox Err & " : " & Err.Description, , "CommandButton1_Click()"
Resume CommandButton1_Click_Exit

End Sub

Courtesy:
The above VBA code was taken from a Forum Post on www.mrexcel.com/Forum and modified to run on the same sample data presented in the earlier article published last week.

The Code on the Worksheet VBA Module is run from the Command Button1 Click Event Procedure.

  1. Roundup Function of Excel in MS-Access
  2. Proper Function of Excel in Microsoft Access
  3. Appending Data from Excel to Access
  4. Writing Excel Data Directly into Access
  5. Printing MS-Access Report from Excel
  6. Copy-Paste Data From Excel to Access 2007
  7. Microsoft Excel-Power in MS-Access
  8. Rounding Function MROUND of Excel
  9. MS-Access Live Data in Excel
  10. Access Live Data in Excel- 2
  11. Opening an Excel Database Directly
  12. Create an Excel Word File from Access
Share:

Writing Excel Data directly into Access Table

Introduction.

Microsoft Access allows you to import data from external sources such as dBase, FoxPro, Excel, or even another Access database. Likewise, you can also export data from Access to these applications, making data exchange and integration seamless.

Following is a list of topics I have published earlier, either on importing, exporting, or working with external data sources from Microsoft Access:

Today, we will explore how to add a range of Excel cell data directly into an Access Table by running the VBA Code from within Excel.

The Algorithm of the program is as given below:

  1. Create an Access Application Object and open it.

  2. Open the target database within the Access Application.

  3. Keep the Access Application window hidden.

  4. Open the target table from the Database.

  5. Take the count of Rows from one of the Excel data columns.

  6. Open a repeating loop to write the Excel data one row at a time, from the second row onwards.

  7. Repeat the writing action till all the rows are transferred to the Access Table.

  8. Close the table and database, and quit the MS-Access Application.

The Excel VBA Code is run by clicking a Command Button on the Excel Sheet. A sample image of the Excel Sheet with data and a Command Button is given below:

The Target Table Structure image is given below:


The Excel VBA Code

Sub Button1_Click()
    Dim objAcc As Object
    Dim recSet As Object
    Dim DataRow As Long, EndRow As Long
    
    On Error GoTo Button1_Click_Err
    
    'Create Access Application Object
    Set objAcc = CreateObject("Access.Application")
    'Open Database in Microsoft Access window
    objAcc.OpenCurrentDatabase "F:\mdbs\Database4XL.accdb", True
    'Keep Access application window hidden
    objAcc.Visible = False
    
    'Open Access Table to add records from Excel
    Set recSet = objAcc.CurrentDb.OpenRecordset("Table1")
    'Take actual row counts of data for transfer
    EndRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row

    With recSet
      For DataRow = 2 To EndRow
        .AddNew
        ![Desc] = Sheet1.Range("A" & DataRow).Value
        ![Qrtr1] = Sheet1.Cells.Range("B" & DataRow).Value
        ![Qrtr2] = Sheet1.Cells.Range("C" & DataRow).Value
        ![Qrtr3] = Sheet1.Cells.Range("D" & DataRow).Value
        ![Qrtr4] = Sheet1.Cells.Range("E" & DataRow).Value
        .Update
      Next
    End With
    recSet.Close
    objAcc.Quit
    Set objAcc = Nothing

Button1_Click_Exit:
Exit Sub

Button1_Click_Err:
MsgBox Err & " : " & Err.Description, , "Button1_Click()"
Resume Button1_Click_Exit
    
End Sub
Courtesy:
The non-functional raw VBA Code presented by a User at www.mrexcel.com/forum/microsoft-access was modified by me to make it functional and was originally submitted there.

The first field of the table is an ID field with the data type AutoNumber. The ID field value is automatically generated when data is inserted into the other fields.

  1. Roundup Function of Excel in MS-Access
  2. Proper Function of Excel in Microsoft Access
  3. Appending Data from Excel to Access
  4. Writing Excel Data Directly into Access
  5. Printing MS-Access Report from Excel
  6. Copy-Paste Data From Excel to Access 2007
  7. Microsoft Excel Power in MS-Access
  8. Rounding Function MROUND of Excel
  9. MS-Access Live Data in Excel
  10. Access Live Data in Excel- 2
  11. Opening an Excel Database Directly
  12. Create an Excel Word File from Access

Share:

Exporting and Importing Data in Text Format

Introduction

This is all about exporting data into a Text File and sending it, through the Internet as an E-mail attachment, to a remote location.  At the receiving end, the Text data is converted back into its original form and added to an existing table.  No field delimiters, field names, or any other details are sent along with the actual data lines.  The Source and Target Tables should have identical Structures, and these are known by the sending and receiving end users only.

Let us take a quick look at some sample data and what they look like when converted into Text Format.

Sample MS-Access Table: Export

MS-Access Table: Export text data-image, when exported into Text File: Export.txt.

As you can see from the above text image that each record from Access Table: Export is converted into a continuous stream of characters and written into the Text File in separate lines.  The Text File is saved with the same name as the Table: Export with the file extension .txt (Export.txt).

The first two data fields on the Source Table are Text Fields (size 15 characters each), the third field is Date type and the next five fields are of Numeric Type.

Data Field details are given below:

Seq Field Type Size
1. LastName Text 15
2. FirstName Text 15
3. DofB Date  
4. Height Number Integer
5. Weight Number Long Integer
6. H Number Single
7. W Number Double
8. Dcml Number Decimal


The VBA txtExport() Function Code

The VBA program given below reads the MS-Access Table, record by record, converts them into text format, and writes out into an external Text File, with the same name as the Source Table.  The text file:Export.txt is created in the Default Database Folder.  I have created the sample data Table with the name Export for Demo purposes only.  You can use any Table from your database, but see that it doesn’t contain any field types other than text, date, or Number.

Public Function txtExport(ByVal tblName As String)
'-----------------------------------------------------
'Purpose: Export Data into Text Format
'Author : a.p.r.pillai
'Date   : June, 2013
'Remarks: All Rights Reserved by www.msaccesstips.com
'-----------------------------------------------------
'Data Types
'----------
'Text - 10 = Actual size
'Date - 8 = 10 characters
'Integer - 3
'Long Integer - 4
'Single - 6
'Double - 7
'Decimal - 20
'Numeric types 3,4,6,7 or 20 = 12 characters

Dim tblSize() As Variant
Dim db As Database, rst As Recordset
Dim fld As Field, fldCount As Integer
Dim j As Integer, tbldef As TableDef
Dim numSize As Integer, dtSize As Integer
Dim fmt As String, outTxt As String
Dim outFileName As String

On Error GoTo txtExport_Err

numSize = 12
dtSize = 10

'Exported Text Filename is same as Tablename with file-extension .Txt
outFileName = tblName & ".txt"

Set db = CurrentDb
Set tbldef = db.TableDefs(tblName)
fldCount = tbldef.Fields.Count - 1
'A singly dimensioned Array of Variant Type 
'is decalred for number of fields in the Table. 
ReDim tblSize(fldCount) 

'The Array is initialized with text data type 
'for appropriate size to hold text, date & Numeric Values 
For j = 0 To fldCount 
   Set fld = tbldef.Fields(j) 
   Select Case fld.Type 
      Case 3, 4, 6, 7, 20 'Numeric data type 
        tblSize(j) = String(numSize, "0") 
      Case 8 'Date Data type 
        tblSize(j) = String(dtSize, "0") 
      Case 10 'Text data type 
        tblSize(j) = String(fld.Size, "x") 'Actual Text Field-size 
    End Select Next 

'Open the Source Table 
    Set rst = db.OpenRecordset(tblName) 
    'Create and open the output text file in the same folder of the database 
    Open outFileName For Output As #1 
    'Read records till the end of Table and convert them into text format 
    Do While Not rst.EOF 
       For j = 0 To fldCount 
          Set fld = tbldef.Fields(j) 
          Select Case fld.Type 
             Case 3, 4, 6, 7, 20 
                fmt = "00000000.000" 
                'position data right-aligned into the text variable 
                RSet tblSize(j) = Format(rst.Fields(j).Value, fmt) 
             Case 8 
                fmt = "dd/mm/yyyy" 
                'position data right-aligned into the text variable 
                RSet tblSize(j) = Format(rst.Fields(j).Value, fmt) 
             Case 10 
                'position data left-aligned into the text variable 
                LSet tblSize(j) = rst.Fields(j).Value 
          End Select 
       Next 
       outTxt = "" 
       For j = 0 To fldCount 
          'join all text data variables into a single text line 
          outTxt = outTxt & tblSize(j) 
       Next 
          'Write into text file 
       Print #1, outTxt 
       'take next record to export 
   rst.MoveNext 
Loop 

'Close the Text File and other files 
Close #1 
rst.Close 
db.Close 

Set db = Nothing 
Set tbldef = Nothing 
Set fld = Nothing 

txtExport_Exit: 
Exit Function 

txtExport_Err: 
MsgBox Err & " : " & Err.Description, , "txtExport()" 
Resume txtExport_Exit 
End Function

Running the Code

You can Run the Program directly from the Debug Window Command line:

Syntax: txtExport "Table Name"

txtExport "Export"

Or run it from a Command Button Click Event Procedure

Private Sub cmdRun_Click()

txtExport "Export"

End Sub

The Data Format Change.

  1. When Text Type Field values are converted into output text the actual size of the field is calculated and the data is left-aligned within the actual size of the text field. If the field value is shorter than the actual size of the field, then the balance character positions are filled with spaces.
  2. Date Field value uses 10 characters (dd/mm/yyyy) when converted into text.
  3. All Numeric Field Values are converted into a 12 character text type and positioned Right-aligned in the output memory image, filled with zeroes at left positions.

NB: Date and Numeric Data text field sizes (Date=10, Number=12) are selected arbitrarily and can be modified if needed.  The MS-Access Table should have only the above three types of Data (Text, Date & Number) Fields in it.

The Text File created from MS-Access Table can be sent through E-Mail Attachment to the remote location.  The VBA Program given below can be used for converting the Text File back into Access Data and append into the Table with the same structure as the Source Table.

Public Function txtImport(ByVal txtFileName As String)
'txtFileName is same as Tablename with file-extension .txt
'-----------------------------------------------------
'Purpose: Import Text-Data into Table
'Author : a.p.r.pillai
'Date   : June, 2013
'Remarks: All Rights Reserved by www.msaccesstips.com
'-----------------------------------------------------
'Data Types
'----------
'Text - 10 = Actual size
'Date - 8 = 10 characters
'Integer - 3
'Long Integer - 4
'Single - 6
'Double - 7
'Decimal - 20
'Numeric types 3,4,6,7 or 20 = 12 characters

Dim tblSize() As Variant
Dim db As Database, rst As Recordset
Dim fld As Field, fldCount As Integer
Dim j As Integer, tbldef As TableDef
Dim numSize As Integer, dtSize As Integer
Dim fmt As String, outTxt As String
Dim inputFileName As String, I As Integer, k As Integer

On Error GoTo txtImport_Err

numSize = 12
dtSize = 10

inputFileName = txtFileName & ".txt"
Set db = CurrentDb
Set tbldef = db.TableDefs(txtFileName)
fldCount = tbldef.Fields.Count - 1

'A singly dimensioned Array of Variant Type
'is decalred for number of fields in the Table.
ReDim tblSize(fldCount)

'The Array is initialized with text data type
'for appropriate size to hold text, date & Numeric Values
For j = 0 To fldCount
   Set fld = tbldef.Fields(j)
   Select Case fld.Type
      Case 3, 4, 6, 7, 20 'Numeric data type
          tblSize(j) = String(numSize, "0")
      Case 8 'Date data type
          tblSize(j) = String(dtSize, "0")
      Case 10 'Text Field
          tblSize(j) = String(fld.Size, "x") ' Actual Text Field-size
   End Select
Next

'Open the Target Table Export
Set rst = db.OpenRecordset(txtFileName)

'Open the input text file
Open inputFileName For Input As #1

'Read the Text file, convert and add the data to the Target Table
  Do While Not EOF(1)
   'Read text data line
   Input #1, outTxt
   I = 1 'first field value off-set
   'Add a new record into the table
   rst.AddNew

   For j = 0 To fldCount
      Set fld = tbldef.Fields(j)
      'read data size for extracting correct number of characters
      'from the text line
      k = Len(tblSize(j))
     
      Select Case fld.Type 'check the current field type
         Case 3, 4, 6, 7, 20 'if numeric data type then
          'Extract numeric data, convert and write into data field
            rst.Fields(j).Value = Val(Mid(outTxt, I, k))
            I = I + k 'increment to next field off-set
         Case 8 'if it is date then
          'Extract Date data, convert and write into data field
            rst.Fields(j).Value = CDate(Mid(outTxt, I, k))
            I = I + k 'increment to next field off-set
         Case 10 'Text data type
          'Extract Date data, convert and write into data field
            rst.Fields(j).Value = Mid(outTxt, I, k)
            I = I + k 'increment to next field off-set
       End Select
    Next
      rst.Update
      'initialize the variable to read the next line of text data
      outTxt = ""
Loop

'No more text data in the file
Close #1
rst.Close
db.Close
Set db = Nothing
Set tbldef = Nothing
Set fld = Nothing

txtImport_Exit:
Exit Function

txtImport_Err:
MsgBox Err & " : " & Err.Description, , "txtImport()"
Resume txtImport_Exit

End Function

Debug Window Command line Run Syntax:

txtImport "Text File Name"

txtImport "Export"

NB: Text File Name is entered without the file extension (.TXT). Target Table should have the same structure as the Source Table.

Share:

Finding Difference between Dates in rows of a Column

Introduction.

Your Company has several Customers who place orders for Products regularly, and you maintain the Orders detail data in an MS-Access Table.  The management would like to know the frequency of each customer order so that the company can plan and acquire adequate stock in advance to meet their requirements in time.

We have a table of Orders (tblOrders), of a particular customer, with the following fields and sample data as shown below:

AutoID OrderNo OrderDate OrderValue Days
1 2012060500 05-06-2012 100000  
2 2012070701 15-07-2012   50000  
3 2012109000 25-10-2012 150000  
4 2012120050 27-12-2012 125000  
5 2013028075 14-02-2013 175000  

Our task is to find the frequency of orders, in the number of days, from this particular customer.  This can be done by finding the difference between the Order Dates.  The sample data records are organized in such a way that they have a sequence number in the first column.  This is very important for the first method we are going to try out.  It is easy to find the OrderDate in the next record with the help of the Dlookup() Function in an MS-Access Query.

Organizing the Data.

We are going to use only two columns from the tblOrders Table, AutoID & OrderDate, and will create a third column Days by finding the difference between Order Dates. 

Here, the data records are organized (as shown above) in such a way that the output in the Days Column can be found with a simple Query.  The Query-based solution works only when the AutoID field has consecutive values and the OrderDate is arranged in Ascending Order. 

The SQL of the sample MS-Access Query is given below:

SELECT tblOrders.AutoID,
 tblOrders.OrderID,
 tblOrders.OrderDate,
 DateValue(nz(DLookUp("OrderDate","tblOrders","AutoID = " & [AutoID]+1),"31-12-1899")) AS EndDate,
 IIf([EndDate]-[OrderDate]<0,0,[EndDate]-[OrderDate]) AS Days
FROM tblOrders
ORDER BY tblOrders.OrderDate;

The result of the run of the Query is shown below:

AutoID OrderID OrderDate EndDate Days
1 2012060500 05-06-2012 15-07-2012 40
2 2012070701 15-07-2012 25-10-2012 102
3 2012109000 25-10-2012 27-12-2012 63
4 2012120050 27-12-2012 14-02-2013 49
5 2013028075 14-02-2013 0 0

Even though the MS-Access Query-based solution looks simple and effective, preparing data with consecutive number values is not that easy, because you will be filtering and creating output data from a larger data file and the auto-number values, if exists, will not be consecutive, if they are taken from the main table.  But, you can create auto-numbers in Query Column very easily with a VBA User-defined Function.  You can find the Code and details here.

The VBA-Based Solution.

The VBA-based solution doesn’t need a column with consecutive numbers. But, the OrderDate field must be sorted in Ascending Order.  To prepare the data from our MS-Access Table tblOrders, as input for our VBA Program FrequencyCalc() we need only a SELECT Query with required fields from the tblOrders Table.  The SQL of the sample Query is given below:

Query: tblOrdersQ – OrderDate field value is sorted in ascending order.

SELECT tblOrders.OrderID,
 tblOrders.OrderDate,
 tblOrders.Days
FROM tblOrders
ORDER BY tblOrders.OrderDate;

VBA Code of the FrequencyCalc() Function is given below:

Public Function FrequencyCalc()
'----------------------------------------------------------
'Author: a.p.r.pillai
'Date  : March 2013
'All Rights Reserved by www.msaccesstips.com
'----------------------------------------------------------
Dim db As Database, rst1 As Recordset, rst2 As Recordset
Dim m_diff As Integer

On Error GoTo FrequencyCalc_Error

Set db = CurrentDb
'Open tblOrdersQ's first instance and position on the first record
Set rst1 = db.OpenRecordset("tblOrdersQ", dbOpenDynaset)
'Open tblOrdersQ's second instance and position on the second record
Set rst2 = db.OpenRecordset("tblOrdersQ", dbOpenDynaset)
rst2.MoveNext

'Find difference between dates from first & second instances of OrderDates
'in the same Query.
'update number of days in the second record onwards.
Do While Not rst1.EOF
   m_diff = rst2!OrderDate - rst1!OrderDate
   If Not rst2.EOF Then
     With rst2
        .Edit
        !Days = m_diff
        .Update
      rst1.MoveNext
        .MoveNext
      End With
      If rst2.EOF Then
         Exit Do
      End If
   End If
Loop
rst1.Close
Set rst1 = Nothing
rst2.Close
Set rst2 = Nothing
db.Close
Set db = Nothing

FrequencyCalc_Exit:
Exit Function

FrequencyCalc_Error:
MsgBox Err & " : " & Err.Description, , "FrequencyCalc()"
Resume FrequencyCalc_Exit
End Function

Demo Run Result of VBA Code.

The run result of the Program is given below:

AutoID OrderID OrderDate Days
1 2012060500 05-06-2012  
2 2012070701 15-07-2012 40
3 2012109000 25-10-2012 102
4 2012120050 27-12-2012 63
5 2013028075 14-02-2013 49

The VBA procedure updates the frequency of Days in the second record onwards, rather than the first record through the sample Query we have tried earlier with the Dlookup() Function.

Technorati Tags:

Earlier Post Link References:

Share:

Opening Specific Page of Pdf File

Introduction.

Opening an external file (such as Word, Excel, or Adobe PDF) from Microsoft Access is straightforward. You can use the Hyperlink tool (Ctrl+K) to browse for a file on disk and assign it as a hyperlink on a form. Another option is to open the Hyperlink tool from the Hyperlink Address property of a label, then browse for and select the desired file.

Once the hyperlink is set, clicking on it will open the file (Word, Excel, or PDF) starting with the first page, according to the document’s default view settings.

The Shell Command.

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

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

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

A.  First Parameter

  1. The parent Application Path Name(C:\Program Files (x86)\adobe\Reader 9.0\Reader\AcroRd32.exe).

  2. The pathname of the PDF file to open (C:\aprpillai\Documents\dosa.pdf).

B.  Second Parameter

  1. open window mode

The Sample Trial Run.

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

  1. Open any one of 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 its 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 a few pages.

  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 file selected with Normal Focus.

After opening the PDF file with page 1 on the top, type a different page number in the navigation control at the bottom of the document to jump to that page.

However, if we already know the page number we want to open, we can pass it as a parameter to the AcroRd32.exe program. For example:

..\AcroRd32.exe /A page=25 ..\dosa.pdf

This command will open the PDF file directly to page 25 instead of starting from the first page.

To demonstrate, let’s modify our earlier program by adding the page parameter (/A page=25) so that the PDF opens at the 5th page. The updated version of the program is shown 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

Note: Do not include spaces on either side of the equal sign in the parameter page=25. The /A switch must immediately follow the program name (AcroRd32.exe), with a space before specifying page=25.

In our example, the file dosa.pdf contains several recipes. To make navigation easier, we should be able to jump directly to a specific recipe with a single click. For this purpose, we can create a Combo Box on the form that lists all recipes, along with their corresponding page numbers and descriptions. By selecting a recipe from the list, the program can pass the correct page number to Acrobat Reader, allowing us to quickly display the chosen recipe.

A Sample Form.

An 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) a little later. 

  1. Open the Form in Design View.

  2. Select the Control Wizard tool to launch 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 the Tab Key.

  6. Type a similar list of topics, shown in the image above, from your PDF file with Page Number in the 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 deselected, 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 items 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 image for a sample view of the dosa.pdf file:

    The Zoom Parameter.

    From the header toolbar, you can see that the current view shows page 7 of 51, with the document opened at about 60% zoom of its actual size. This zoom level can also be controlled programmatically. By specifying the Zoom parameter immediately after the Page parameter, we can open the PDF document to both the desired page and zoom percentage.

    To demonstrate this, I created a second Combo Box control on the form, named cboZoom, which contains a list of zoom percentage values: 50, 60, 70, 80, 90, 100, and 120. By selecting one of these values along with the page number, the PDF document can be opened not only at the correct page but also at the preferred zoom level for easier viewing.

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 combine the parameter key names (page, zoom) with the control values (page number and zoom percentage), the result should be the sample value shown earlier.

To test this, you can place a Text Box on the form with the name cboZoom. Enter a zoom percentage value in this control (note: do not include the % symbol), then run the code to confirm that it works.

Important: If both controls—cboPage and cboZoom—are left empty, the PDF file will open by default with the first page on top and at 100% zoom.

Technorati Tags:
Share:

Centralized Error Handler and Error Log

Introduction.

In an earlier article on the VBA Utility program, we explored how to scan through a VBA module—whether a standard module or a form/report class module—and automatically insert missing error-handling lines. You can find the link to that article here.

This utility program can save you considerable time that would otherwise be spent typing, copying and pasting, and modifying hundreds of lines of error-trapping code in your subroutines and functions. The main purpose of an error handler is to manage unexpected errors and, when necessary, report them to the developer so that the underlying issue can be permanently fixed. At the same time, the program should not terminate abruptly. If it is a minor issue, the user should be able to dismiss the error and continue working without interruption.

A typical project may contain hundreds of subroutines and functions across standard modules and Form/Report modules. When an error occurs, the message typically includes the error number and description. If the procedure name is included in the MsgBox() function’s title parameter, it will also appear in the message box title. However, users often overlook this important detail, which could otherwise help the developer quickly locate the exact procedure where the error occurred and resolve it efficiently.

A Common Error Handler.

A more effective approach to handling such issues is to create a centralized error handler and maintain an error log Text File on disk. Whenever an error occurs in a function or subroutine, the common error handler can be called with the necessary parameters, like the Error number, Description, procedure name, module name, and database name. The handler will both display the error message to the user and record the details in a log file.

If several Microsoft Access applications are running on a Local Area Network, all of their error log information can be saved to a single shared text file on the Server. Each log entry will include details like the date, time, module name, and database name, along with the usual error number and description, creating a consolidated and traceable error history.

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


Error Message Info.

Each error log entry contains all the essential details—such as the date and time of the error, database path, module name, and procedure name—to precisely identify where the error occurred. Even if users choose not to report problems, the administrator can periodically review the log file to monitor the application’s overall health and address issues proactively.

The Trial Run.

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 an 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

Common Error Handler Info and Log File.

When the above program runs into an error, it calls the BugHandler() Program and passes the Module Name and Database Path as the 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

The Library Database.

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

This method will write out the details of errors from your databases into a commonplace, 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 it out.

Technorati Tags:
Share:

Saving Report Pages as separate PDF Files

Introduction.

When printing multiple customer invoices as a single report, you often face the challenge of separating them for physical mailing.

A more efficient solution is to save each invoice as a separate PDF file on disk. This makes it simple to send invoices directly to customers via email. The benefits are immediate: reduced stationery costs, faster delivery straight to the customer’s inbox, and greater convenience for customers, who can view the invoices on their devices or print them if needed.

In short, part of the workload shifts to the customer—saving both time and money on your end.

Prepare for a Sample Run.

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) sample database:
    • Order Details
    • Products 

    Note: The examples use tables from the Northwind.mdb database. However, the queries, reports, and code will be executed in Access 2007. The Products table is not used directly in the query or report, but the ProductID combo box in the Order Details table references it to display product descriptions.

  2. Open a new Query in SQL View without selecting any Table/Query from the displayed list.
  3. Data Preparation Queries.

  4. 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];
  5. After saving and closing the above Query, create another Query, using Invoice_Orders_0 as the source, with the following SQL:
    SELECT Invoice_Orders_0.*
    FROM Invoice_Orders_0
    WHERE (((Invoice_Orders_0.OrderID)=10258));
  6. Save the new Query with the name Invoice_Orders_1.
  7. Design Sample Report.

  8. Design a Report to print Sales invoices using the Invoice_Orders_1 Query as the Record Source.

    Sample Report Design Image is given below:

    Save the Report with the name Rpt_Invoice. Sample Report Preview Image:


    The Create_PDF() Function.


  9. 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

How it Works.

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 the Order Details table for the Customer Invoice Report. It also calculates the total value of each record after applying the discount. However, this query does not include any criteria for selecting a specific OrderID or range of OrderIDs for invoice printing.

The second query (Invoice_Orders_1) is based on Invoice_Orders_0 and applies criteria to select a specific OrderID. Using a two-step query structure keeps the SQL simpler. Later, we incorporate the SQL into VBA code to dynamically update the criteria with different OrderIDs, so that each invoice can be generated and saved as a separate PDF file.

In addition, we use a third query—defined as a SQL string variable (SQLParam) within the Create_PDF() function. This query is executed through the statement:

Set rst = db.OpenRecordset(SQLParam, dbOpenDynaset) 

When calling the Create_PDF() function, you must provide three parameters: the Order Start Number, the Order End Number, and the target folder path where the PDF files should be saved. The third query retrieves all order numbers within the specified range, and each order is processed individually to generate separate invoice 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, 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 their details or refinement.

Let us keep that point in mind, and we will continue to review what we are doing in the VBA Code lines.  You must call the Function using the following:

Syntax:

Create_PDF  Start_Number,  End_Number, ”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 the Rpt_Invoice Report is Invoice_Orders_1 Query. This is redefined for each Order-Id as criteria for printing the Rpt_Invoice in PDF format.  The PDF files are saved in the location specified as the third parameter, C:\My Documents.

Each line in the VBA Code is commented at each step. Please go through them to understand the code.

Technorati Tags:
Share:

Assigning Module Level Error Trap Routines

Assigning Module-Level Error Trap Routines.

Last week, I introduced a function that automatically inserts error-handling lines into a VBA function or subroutine. While readers appreciated its usefulness, some felt the process was a bit cumbersome.

Before running that function, the user had to identify some text to search for and then execute the function with that text as a parameter. The utility relied on the 'Text.Find()' method of the Module object to locate the specified text and select the corresponding line within the target function or subroutine. From that starting point, it could determine other details—such as the total number of lines in the procedure, the line number of the header, and the line number of the end statement. These values were necessary to insert the error-handling lines in the correct locations.

However, when working with multiple functions or subroutines, this method becomes time-consuming, as each one must be processed individually.

In this article, we’ll explore an improved version of the utility that scans an entire module and inserts error-handling lines into all functions and subroutines in a single pass.

Before we dive in, here are links to the earlier articles, in case you’d like to revisit the simpler methods we tried using the Module object:

The ErrorTrap() Function.

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

Running the Function.

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

ErrorTrap “Module Name”

Example-1:

ErrorTrap "Module3"

Module 3 will be scanned for Procedure Names, and each procedure is checked for the presence of existing Error Handling lines.  If the ‘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 the 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.

Saving the code in the Library Database

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 Access 2007 keeps crashing every time, and finally, I 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 did the test runs on this function several times and found it ok, but field testing may be required in different environments to detect logical errors.  If you find any such errors, please give me feedback through the comment section of this page.  Review each module immediately after running this function for accuracy and use it at your own risk. 

Technorati Tags:
Share:

PRESENTATION: ACCESS USER GROUPS (EUROPE)

Translate

PageRank

Post Feed


Search

Popular Posts

Blog Archive

Powered by Blogger.

Labels

Forms Functions How Tos MS-Access Security Reports msaccess forms Animations msaccess animation Utilities msaccess controls Access and Internet MS-Access Scurity MS-Access and Internet External Links Queries Array Class Module msaccess reports Accesstips msaccess tips WithEvents Downloads Objects Menus and Toolbars MsaccessLinks Process Controls Art Work Collection Object Property msaccess How Tos Combo Boxes ListView Control Query VBA msaccessQuery Calculation Dictionary Object Event Graph Charts ImageList Control List Boxes TreeView Control Command Buttons Controls Data Emails and Alerts Form Custom Functions Custom Wizards DOS Commands Data Type Key Object Reference ms-access functions msaccess functions msaccess graphs msaccess reporttricks Command Button Report msaccess menus msaccessprocess security advanced Access Security Add Auto-Number Field Type Form Instances ImageList Item Macros Menus Nodes Recordset Top Values Variables msaccess email progressmeter Access2007 Copy Excel Expression Fields Join Methods Microsoft Numbering System RaiseEvent Records Security Split SubForm Table Tables Time Difference Utility WScript Workgroup Wrapper Classes database function msaccess wizards tutorial Access Emails and Alerts Access Fields Access How Tos Access Mail Merge Access2003 Accounting Year Action Animation Attachment Binary Numbers Bookmarks Budgeting ChDir Color Palette Common Controls Conditional Formatting Data Filtering Database Records Defining Pages Desktop Shortcuts Diagram Disk Dynamic Lookup Error Handler Export External Filter Formatting Groups Hexadecimal Numbers Import Labels List Logo Macro Mail Merge Main Form Memo Message Box Monitoring Octal Numbers Operating System Paste Primary-Key Product Rank Reading Remove Rich Text Sequence SetFocus Summary Tab-Page Union Query User Users Water-Mark Word automatically commands hyperlinks iSeries Date iif ms-access msaccess msaccess alerts pdf files reference restore switch text toolbar updating upload vba code