January 2010 ~ LEARN MS-ACCESS TIPS AND TRICKS

Indexing and Sorting with VBA

a.p.r. pillaiJanuary 28, 2010msaccessprocess, Process Controls No comments

Introduction

A Table is normally created with a Primary Key or Index to arrange the records in a certain order to view or process. Primary Key or Index can have one or more fields, in order to make the Key values Unique, if this is not possible with a single field value.

If you open the Employees Table from C:\Program Files\Microsoft Office\Office11\Samples\Northwind.mdb sample Database in the design view you can see that the EmployeeID Field is defined as the Primary Key.

To create an Index manually and define it as a Primary Key:

Open the Table in Design View.
Click on the left side of the Field Name to select it.
Click on the Indexes Toolbar Button.
You may give any suitable name in the Index Name Field, replacing the PrimaryKey text, if you would like to do so.

If the Record Values in the selected field are not unique then you can select more data fields (up to a maximum of ten Fields) to form Unique Key for the Primary Key.

You may click and drag over the Fields to select them (if they are adjoining fields) or click on each field by holding the Ctrl Key to select fields randomly.

The above procedure is creating a Primary Key Index for the Table. We can create more than one Index for a Table. But, only one Index can be active at one time.

Creating Index with VBA.

We can activate an existing Index of a Table or create a new Index through VBA and use it for data processing. We will learn here how to create a new Index with the name myIndex for a Table through VBA, activate it, use it for data processing and delete it at the end of the process.

We must validate the presence of myIndex in the Indexes collection of the Table if found, then activate it, otherwise create myIndex and activate it for data processing.

We will use the Orders and Order details Table from the Northwind.mdb sample database. We will organize the Order Details Table in the Order Number sequence so that the Order-wise Total Value of all items can be calculated and updated on the same Order record in Orders Table.

The Data Processing Steps

Following are the data processing steps, which we follow in the VBA Routine to update the Orders Table with order-wise Total Value from Order Details Table:

Open Orders Table for Update Mode.
Open Orders Details Table, for Input.
Check for the presence of myIndex in the Order Details Table, if found, then activate it, otherwise create myIndex and activate it as the current Index.
Initialize the Total to Zero.
Read the first record from the Order details Table.
Calculate the Total Value of the item using the Expression: Quantity * ((1-Discount%)*UnitPrice).
Add the Value to the Total.
Read the next record and compare it with the earlier Order Number, if same then repeat step 6 and 7 until the Order Number changes or no more records to process from the Order Details Table.
Find the record with the Order Number in Orders Table.
If found, then edit and update the total into the total value Field in Orders Table.
Check for the End Of File (EOF) condition of the Order Details Table.
If False then repeats the Process from Step 4 onwards, otherwise Close files, and stop Run.

Prepare for a Trial Run.

To try the above method Import Orders and Order Details Tables from C:\Program Files\Microsoft Office\Office11\Samples\Northwind.mdb (Access 2003) or C:\Users\User\My documents\Northwind 2007.accdb (Access 2007, if not available then you must create from Local Templates)
Open Orders Table in Design View.
Add a new Field with the name Total Value with Numeric (Double) data Type in Orders Table.

You may display the Index List of this Table to view its Primary Key Index on the Order ID field.
Save the Orders Table.
Open the VBA Editing Window (Alt+F11).
Create a new Standard Module from Insert Menu.

Copy and Paste the following VBA Routine and save the Module.

The CreateIndex() Function.

Public Function CreateIndex()
Dim db As Database, fld As Field, tbldef As TableDef
Dim idx As Index, rst As Recordset, PreviousOrderID As Long
Dim CurrentOrderID As LongDim xQuantity As Long, xUnitPrice As Double
Dim xDiscount As Double, Total As Double, rst2 As Recordset

On Error Resume Next

Set db = CurrentDb
Set rst = db.OpenRecordset("Order Details", dbOpenTable)
'Check for presence of myIndex, if found set as current
rst.Index = "myIndex"
If Err = 3800 Then
'myIndex not found
    Err.Clear
    GoSub myNewIndex
End If

On Error GoTo CreateIndex_Err

Set rst2 = db.OpenRecordset("Orders", dbOpenTable)
rst2.Index = "PrimaryKey"
PreviousOrderID = rst![Order ID]
CurrentOrderID = PreviousOrderID
Do Until rst.EOF
    Total = 0
    Do While CurrentOrderID = PreviousOrderID
        xQuantity = rst![quantity]
        xUnitPrice = rst![unit price]
        xDiscount = rst![discount]

        Total = Total + (xQuantity * ((1 - xDiscount) * xUnitPrice))
        rst.MoveNext
        PreviousOrderID = CurrentOrderID
        If Not rst.EOF Then
            CurrentOrderID = rst![Order ID]
        Else
            Exit Do
        End If
    Loop
    rst2.Seek "=", PreviousOrderID
    If Not rst2.NoMatch Then
        rst2.Edit
        rst2![totalvalue] = Total
        rst2.Update
    End If
    PreviousOrderID = CurrentOrderID
Loop

rst.Close
rst2.Close

'Delete temporary Index
Set tbldef = db.TableDefs("Order details")
tbldef.Indexes.Delete "myIndex"

CreateIndex_Exit:
Exit Function

myNewIndex:
rst.Close
Set tbldef = db.TableDefs("Order Details")
Set idx = tbldef.CreateIndex("myIndex")

Set fld = tbldef.CreateField("Order ID", dbLong)
idx.Fields.Append fld
Set fld = tbldef.CreateField("Product ID", dbLong)
idx.Fields.Append fld
tbldef.Indexes.Append idx
tbldef.Indexes.Refresh
Set rst = db.OpenRecordset("Order Details", dbOpenTable)
rst.Index = "myIndex"
Return

CreateIndex_Err:
MsgBox Err.Description, , "CreateIndex()"
Resume CreateIndex_Exit

End Function

Click somewhere in the middle of the VBA Routine and press F5 or click Run Command Button to execute the Code and update the Orders Table.

At the beginning part of the Code, we are attempting to make one of the Indexes (myIndex) of the Order Details Table active. Since myIndex is not yet created in the Table this action runs into an Error condition. We are trapping this Error Code and passing control to the Sub-Routine to create myIndex and to add it to the Indexes collection. The new Index is activated in preparation for data processing.

The next steps calculate Order-wise Total Values and updates on Orders Table.

At the end of the process, myIndex is deleted from the Indexes Collection of Order Details Table.

Earlier Post Link References:

Data Upload Controls

a.p.r. pillaiJanuary 13, 2010Process Controls 2 comments

Introduction

In some Projects, we have to upload data regularly from external data sources like dBase, Excel, flat files like CSV, Text, and so on. The external file can remain linked to the Project and the data from them can be added to the local MS-Access Table for preparing Reports

For example, we have an MS-Access Application that prepares monthly Reports, on the Profitability of Businesses, and to do that we must upload new data from the LAN, replaced every month from a remote location, in one of the file-formats mentioned above.

If our Application is designed in such a way that when the existing linked file is replaced with a new one on a LAN, with the same name, then the Project must be able to identify the presence of new data in the attached file and allow the user to upload the new records into the master file. But, before this action is implemented it becomes our responsibility as a developer to see that the data once uploaded is not duplicated in the System.

To do this we must install a procedure that will check for the presence of new data in the attached File. If found, then enable a Command Button that will allow the user to click and upload the new data into the System. Otherwise, keep the Command Button disabled till such time fresh data is detected in the attached file.

So, how do we detect the presence of fresh data in the attached file? Depending on the type of file we can use different approaches to determine the presence of fresh data in the attached file by checking the continuity of some Control Number like Invoice Number or the Last Receipt Date, or any other set of unique values that you can depend on from the last uploaded data, and compare them with those Values of the attached file. If the compared values in both files are the same, then we can assume that the attached file contents are already uploaded earlier, otherwise prepare to upload fresh data. For this kind of checking we may prepare a few Queries to filter the set of values from both files and read those values into a VBA routine to compare and control the flow of action.

But, I use a simple method to check the presence of new data in the attached file. Before going into that we have to consider a few other issues. If the attached external file is on the local drive of each User and all of them are allowed to run the upload action, then it is difficult to keep control of this action and the data can go wrong as well. If the attached file is kept on the Server and only one authorized user is allowed to execute the Upload action, then there can be some control over the procedure. Depending on all these considerations we have to devise a method to upload the data correctly into the database.

External Data Source Files.

I have several Applications that upload data from the IBM AS400 System, dBase, Excel, and AS400 Report Spool Files too. I have tried out several methods to detect the presence of fresh information in those files using Queries with control data from tables within the Database and linked tables. Perhaps, you may wonder what I did for AS400 Report Spool File with hundreds of Pages saved directly on the LAN by the EDP Department. This File cannot be kept attached to the database because it doesn't have the correct data table format except for the Detail Lines.

I have developed programs that will read the spool file line by line and discard unwanted lines like Header, Footer, underlines, blank lines, etc., and to take only the data lines cut into text fields in a Table initially before converting each field value into their respective data types and write it out into a new table.

But, the question remains as to how to keep track of the presence of the new Report Spool File that cannot be kept attached to the Database at all. It is a simple trick. At the end of the upload action of the current file, I will make a copy of the first 50 lines of the Spool File and create a second control file. Whenever the Application is open by the User a program is run to open both files and do a line-by-line comparison. If there is no difference in the first 50 lines of both files, then the data was already uploaded into the System otherwise the System is prepared to upload fresh data from the new file.

A Common Simple Method is suitable for all Types of Files.

After trying several methods with different file types I thought we needed a simple method that should work for all kinds of files (attached to the system or not) and created one, which is presented below for your use if needed.

We need a small table with the following Fields:

Field Name	Data Type	Field Size
FileLength	Long Integer
FileDateTime	Date/Time
UserName	Text	25
UploadDate	Date/Time
FilePath	Text	255

The sample table in Datasheet View:

The idea works something like this. When we upload the file contents we will save some basic information about the attached file, like File-Size in a number of bytes and the last modified date and time of the file. Besides that, the name of the User (if the database is implemented with Microsoft Access Security) who is authorized to run the upload action and the date of the last upload event took place.

We can read the attached File-Size in bytes with the Function: FileLen(PathName) and the File's last modified Date and Time can be obtained with the Function FileDateTime(PathName). After the upload action, these values can be updated in the above table to cross-check with the values of the external file to determine the presence of new data. If needed, we can set the attached file's Read-Only attribute ON with the Function SetAttr(PathName, vbReadOnly) so that the file can be protected from inadvertent changes. It can be reset to Normal with SetAttr(PathName, vbNormal).

A program must be run immediately after the Main Switchboard Form is open and cross-check the File-size and the File Date/Time recorded in the table with the attached file's attributes if found different then we can be sure that new data have arrived and enabled the Command Button so that the User can click and upload new data.

But, if the User kept the Application open and replaced the attached file with a new one, then the Button will remain disabled because the status checking program runs only when the Main Switchboard opens. Instead of asking the user to close and open the Application again, as a standard procedure in these circumstances, we can create another Command Button with Refresh Caption so that when the user clicks on this Button we can run the above procedure and enable the Upload Button if the file attributes indicate the presence of a new file.

A sample VBA Routine is given below that reads the information from the table and cross-checks with the attributes of the attached file and Enable/Disable the Upload Command Button.

The UploadControl() Function Code.

Public Function UploadControl(ByVal frmName As String)
'------------------------------------------------------
'Author   : a.p.r. pillai
'Date     : January-2010
'Remarks  : Data Upload control Routine
'         : All Rights Reserved by www.msaccesstips.com
'------------------------------------------------------
Dim frm As Form, lnglastFileSize, dtlastModified, txtFilePath
Dim lngExternalFileSize, dtExternalModified, authUser
Dim tblControl As String, cmdCtrl As CommandButton

tblControl = "UploadCtrl"
authUser = "LizzaMinnelli"
Set frm = Forms(frmName)
Set cmdCtrl = frm.Controls("cmdUpload")

'Read last recorded information from the Control Table
lnglastFileSize = DLookup("FileLen", tblControl)
dtlastModified = DLookup("FileDateTime", tblControl)
txtFilePath = DLookup("FilePath", tblControl)

'Get the External File information
lngExternalFileSize = FileLen(txtFilePath)
dtExternalModified = FileDateTime(txtFilePath)

If (lngExternalFileSize <> lnglastFileSize) And (dtlastModified <> dtExternalModified) Then
    If CurrentUser = authUser Then
        cmdCtrl.Enabled = True
    Else
        cmdCtrl.Enabled = False
    End If
End If

End Function

The Main Switch Board, which has a Command Button with the name cmdUpload, should call the above Program through the Form_Current() Event Procedure of the Form passing the Form Name as Parameter like the following example:

Private Sub Form_Current()
    UploadControl Me.Name
End Sub

If Uploading authority is assigned to a particular User then the Current User's User ID (retrieved with the function CurrentUser()) also can be checked with the UserName Field Value before enabling the Command Button cmdUpload.

Auto Numbering In Query Column

a.p.r. pillaiJanuary 05, 2010msaccessQuery, Queries 18 comments

Introduction

Find New Auto-Numbers in Query Column Version-2 on this link.

For creating "Running Sum Values in Query-Column" visit the following link:

Running Sum in MS-Access Query.

We know how to create an Auto-number Field in a Table to generate Unique Sequence numbers automatically for the records added to the Table. We know how to create Sequence Numbers for data lines on Reports.

On The Reports.

On Reports, create a TextBox in the Detail Section of the Report, write the expression =1 in the Control Source Property and, change the Running Sum Property Value to Over All or Over Group. If you need sequence numbers for each Group separately, depending on the Sorting and Grouping settings on the Report, then the Over Group option must be set in the Property otherwise set the Over All value, for continuous numbers from the start of the Report to the End.

If you want to create a Running Sum value of a Field, like Quantity or Total Price, then set the Running Sum Property value as explained above. For more details on Running Sum as well as creating Page-wise Totals on Access Reports visit the Page with the Title: MS-Access Report and Page Totals.

In The Query Column.

But, Auto-numbering in the Query Column looks somewhat strange to ask for, unless you want to use the Query result for display purposes or the output created from that should have sequence numbers for some reason.

Products Category Group-level sequence numbers or for creating Rank List for students based on their obtained marks and so on.

Or after filtering the records in the Query the Auto-number field values gone out of sequence.

Anyway, this requirement was raised by a participant in an MS-Access Users Forum on the Net and nobody (including me) could give a clear-cut solution except for some alternatives. I chipped in with a solution of my own, even though I was not happy with that either.

The Access User who raised the question in the Forum made direct contact by sending an e-mail to me asking for a solution.

This made me think again on that topic and did a few trial runs of a few simple methods. Finally, I could come up with a Function that can do the trick and I am presenting it here so that you can also use it if you really need it.

Need Trial and Error Runs.

It is important to know the usage of the QrySeq() Function in a new Column of Query to create Sequence Numbers. The Function must be called with a few Parameter Values using the value(s) from the Query Column(s) itself. So, before presenting the VBA Code of the Function I will give some details of the Parameters.

Usage of the Function in the Query Column is as shown below:

SRLNO: QrySeq([ORDERID], "[ORDERID]", "QUERY4")

The QrySeq() Function needs three Parameters.

The First Parameter must be Unique Values available from any Column in the Query.
The second Parameter is the Column Name of the first parameter in Quotes.
The third Parameter is the Name of the Query, from which you call the Function.

The Query, from where the QrySeq() Function is called should have a column of Unique Values, like Autonumber or Primary Key Field. If this is not readily available, then create a Column by joining two or more existing fields (like NewColumn:([OrderlD] & [ShippName] & [RequiredDate] & [Quantity] from the existing column values and ensure that this will form Unique values in all records and pass this Column value ([NewColumn]) as the first Parameter.

The first Parameter Column Name must be passed to the Function in Quotes ("[NewColumn]") as the second parameter.

The Name of the Query must be passed as the third parameter.

NB: Ensure that you save the Query first, after every change to the design of the Query, before opening it in Normal View, to create the Sequence Numbers correctly.

The QrySeq() Function Code

Now then, the simple rules are in place and it is time to try out the Function.

Copy and Paste the following VBA Code into a Standard Module in your Database:

Option Compare Database
Option Explicit

Dim varArray() As Variant, i As Long

Public Function QrySeq(ByVal fldvalue, ByVal fldName As String, ByVal QryName As String) As Long
'-------------------------------------------------------------------
'Purpose: Create Sequence Numbers in Query in a new Column
'Author : a.p.r. pillai
'Date : Dec. 2009
'All Rights Reserved by www.msaccesstips.com
'-------------------------------------------------------------------
'Parameter values
'-------------------------------------------------------------------
'1 : Column Value - must be unique Values from the Query
'2 : Column Name  - the Field Name from Unique Value Taken
'3 : Query Name   - Name of the Query this Function is Called from
'-------------------------------------------------------------------
'Limitations - Function must be called with a Unique Field Value
'            - as First Parameter
'            - Need to Save the Query after change before opening
'            - in normal View.
'-------------------------------------------------------------------
Dim k As Long
On Error GoTo QrySeq_Err

restart:
If i = 0 Or DCount("*", QryName) <> i Then
Dim j As Long, db As Database, rst As Recordset

i = DCount("*", QryName)
ReDim varArray(1 To i, 1 To 3) As Variant
Set db = CurrentDb
Set rst = db.OpenRecordset(QryName, dbOpenDynaset)
For j = 1 To i
    varArray(j, 1) = rst.Fields(fldName).Value
    varArray(j, 2) = j
    varArray(j, 3) = fldName
    rst.MoveNext
Next
rst.Close
End If

If varArray(1, 3) & varArray(1, 1) <> (fldName & DLookup(fldName, QryName)) Then
    i = 0
    GoTo restart
End If

For k = 1 To i
If varArray(k, 1) = fldvalue Then
    QrySeq = varArray(k, 2)
    Exit Function
End If
Next

QrySeq_Exit:
Exit Function

QrySeq_Err:
MsgBox Err & " : " & Err.Description, , "QrySeqQ"
Resume QrySeq_Exit

End Function

The Sample Trial Run

Import the Orders Table from C:\Program Files\Microsoft Office\Office11\Samples\Northwind.mdb sample database.
Copy and Paste the following SQL String into the SQL Editing View of a New Query and save the Query with the Name: AutoNumberQuery:
```
SELECT Orders.*, QrySeq([OrderID],"OrderID","AutoNumberQuery") AS SRLNO
FROM Orders;
```
Select Save from File Menu or click on the Save Toolbar Button.
Open the Query in the normal view.

Check the SRLNO Column for Sequence Numbers.

Here, the OrderID in the Orders Table has unique field values and we could easily get away with the Sequence Numbers correctly in SRLNO Column.

Let us pretend for a moment that we don't have a single field with Unique Values in the Query. We must create a Column with Unique Values by joining two or more Columns available in the Query and pass it to the QrySeq() Function.

Let us try such an example with the Orders Table.

Copy and Paste the following SQL String into a new Query and Save the Query with the name AutoNumberQuery2.

SELECT Orders.*, [ShipName] & [RequiredDate] AS NewColumn, QrySeq([NewColumn],"NewColumn","AutoNumberQuery2") AS SRLNO
FROM Orders;

Open the Query in normal View to check whether the Serial Numbers were created correctly or not.

Ensuring Accuracy

When there are hundreds/Thousands of records in the Query it is difficult to check whether the Column Values we have passed to the Function are really unique and the Serial Numbers generated have no duplicates in them by manually checking through the records. Instead, we will take a Count of Serial Numbers appearing more than once in the Records, if any, with the use of a Total Query using AutoNumberQuery2 as the Source.

Create a new Query uses the following SQL String and name the new Query as DuplicatesCheckQ:

SELECT AutoNumberQuery2.SRLNO,
 Count(AutoNumberQuery2.SRLNO) AS CountOfSRLNO
FROM AutoNumberQuery2
GROUP BY AutoNumberQuery2.SRLNO
HAVING (((Count(AutoNumberQuery2.SRLNO))>1));

Open DuplicatesCheckQ Query in Normal View.

You will find the following result showing SRLNO Column is having the same number appearing more than once in the records indicating that the Unique Column Values we have created for the Function are not really Unique and have duplicates in them.

This can be rectified only by adding more Column Values to the NewColumn expression to eliminate the chance of ending up with duplicates.

This method is only an alternative in the absence of an AutoNumber or Primary Key field Values and not with a 100% percent success rate because when you add more records to the Source Table it is likely that it can fail again. In this case, the only solution is to join more fields to the expression in NewColumn so that we can reduce the chance of failures.

Now, to correct the above Query adds the [Freight] Value Column also to the NewColumn expression. Or Copy and paste the following SQL String into the AutoNumberQuery2 Query overwrites the earlier SQL string in there and save the Query.

SELECT Orders.*,
 [ShipName] & [RequiredDate] & [Freight] AS NewColumn,
 QrySeq([NewColumn],
"NewColumn";,"AutoNumberQuery2") AS SRLNO
FROM Orders;

Open the DuplicatesCheckQ Query again to check for duplicates. If the result is empty, then the Sequence Numbers generated will be correct.

Found Different Method, Share it With me.

If you have a better solution to this, then please share it with me too. I don't need a refined version of the above Code or method, but a different approach to arrive at the same or better result.