Software Catalog:
Automation Introduction

Programming with VBA

It may seem as if we're getting a bit ahead of ourselves by introducing programming with Visual BASIC for Applications at this early place in application development. But if we have the BASIC sub-routines ready when the forms are created we can do the necessary linking without having to go back and do it later. It will be a more efficient use of our time.

We will begin by writing the source code to calculate the ID Code for the Manufacturers table. The sub routine will accept parameters so it will be used by all of the tables except Software for the ID number creation.

The code in today's listings is divided into five functions. I used functions instead of procedures (identified as "sub" for sub routine) so that a calculated value would be returned directly to the caller of the function. This above paragraph will all make sense shortly, I hope.

I have searched the code to change key language words to upper case to make them more easily identified. The Visual BASIC code editor forces its own capitalization conventions on much of the code entered.

Many identifiers i.e. names of variables and procedures, are compound words with upper case letters inserted to make them more readable. With many programming languages the code formatting is really for the human reader. The compilers don't care how the code is formatted so far as lines and spaces are concerned, but Visual BASIC reads by the line. If a statement is too long to keep it together on one line we can use the line continuing symbol. That is an underscore " _" at the end of the line that continues.

I have included rather detailed comments at appropriate places in the code, so I won't repeat the descriptions here. The comments are preceded by an apostrophe and italicized.

Open a new Module. Click the Module tab in the database window. Click New and the code editor will pop up. Enter the function declaration of Listing 1. That is the line that includes the Key word "Function" along with the parameters it expects to have passed to it and the type of data it will return to the program. Notice that Microsoft Access inserts a blank line and "End Function" as soon as you press ENTER at the end of the function declaration. Save the module with the name Global. Enter the remainder of Listing 1. Remember to click that save button with the diskette icon often!

Enter the functions in listings 2 through 5. Notice that they are declared "Private." This is because they are only available to functions in the Global module. When you have entered all of the code you'll be ready to tie it to the Manufacturers Entry / Edit Form.

Listing 1

PUBLIC FUNCTION CalcIDCode(ByVal ItemName, ByVal TableCode As String)As String

**************************************************************************************
` Calculate Record ID number based on the name of the item described by the record.
**************************************************************************************
' Declare all variables before using them
DIM temp As String
DIM IName As String
DIM Ltr As String

DIM Dig As String
DIM L As Integer
DIM Spc1 As Integer
' holds the ID string as it is calculated
' holds a copy of ItemName passed to the function
' holds the 5th letter of ItemName to be passed to
' another function
' the string value of a digit
' holds the length of ItemName
' position of first space in ItemName

` Crash insurance in case the name was left blank
If ISNULL(ItemName) Then EXIT FUNCTION

` Find Length of ItemName & initialize I for DO WHILE loop
L = LEN(ItemName

` Initialize the digit variable to empty string
Dig = ""

` Protect ItemName from accidental modification
IName = ItemName : Iname = StripIllegalChrs(Iname)
IF L > 5 THEN L = 5
IName = UCASE(IName)
' IF the length is greater than 5 make it 5
' Make all the letters upper case

` Extract the 5th letter of ItemName or pad with 0s
SELECT CASE L
CASE 5 ' if L is 5
temp = LEFT$(IName, 4)
Ltr = MID$(IName, 5, 1) 		' Extract the first 4 letters
' Get the 5th letter.

' If it's a space or null replace it with a 0
IF Ltr = CHR(32) Or ISNULL(Ltr) Then
temp = temp & "0"
ELSE ' send Ltr to find the numerical digit
Dig = GetTheDigit(Ltr)
temp = temp & Dig
' tack the number on the end
END IF
CASE 4
temp = LEFT$(IName, 4) & "0" ' get 4 letters and 0 pad to 5
CASE 3
temp = LEFT$(IName, 3) & "00" ' get 4 letters and 0 pad to 5
CASE 2
temp = LEFT$(IName, 2) & "000"
END SELECT

` Tack the table identifier on the front of Temp. This makes a 6 character code.
temp = TableCode & temp

` Now we'll determine the last two characters, the 2nd & 3rd numbers
temp = CalcNextIDNum(temp, ItemName)

` Assign the calculated ID code to the function name
CalcIDCode = temp

END FUNCTION

End of Listing 1

Listing 2

PRIVATE FUNCTION GetTableName (TblCode As String) As String

**************************************************************************************
' This function looks into TableLookUp and retrieves the name of the table you are
' working with based on the Table Code passed in the function call to CalcIDCode.
**************************************************************************************

' Declare all variables before using them
DIM ThisDB As DATABASE
DIM tblRead As Recordset
DIM TempCode As String
DIM TempTableStr As String
DIM SQLstr As String
DIM tempIDFldStr As String
DIM tempNameFldStr As String
DIM MsgStr As String
' Database assumed open
' to hold recordset
' holds TableCodes read from the recordset
' holds TableNames read from the recordset
' holds SQL statement
' holds fieldName of ID field
' holds fieldName of Name field
' Holds Message


' Construct an SQL statement to extract a record from TableLookUp. Except for the
' variable TblCode which holds the code, the language is very readable. Notice the "."
' between the table name and the field. This makes the field name more easily identifiable
' to the Microsoft Access database engine.

SQLstr = "SELECT DISTINCTROW * FROM TableLookUp " & "WHERE " & _
(((TableLookup.TableCode) = " & TblCode & "`));"

Set ThisDB = CurrentDb
` Tell which database to look in

` Create a recordset
Set tblRead = ThisDB.OPENRECORDSET(SQLstr)
` If TblCode exists in the table Read the field values of the recordset.
` Field names hard coded because this procedure will not be used for
` another table, so they will not change .

IF tblRead <> NIL THEN
TempCode = tblRead.Fields("TableCode")
TempTableStr = tblRead.Fields("TableName")
tempIDFldStr = tblRead.Fields("TableID")
tempNameFldStr = tblRead.Fields("TableItemName")
ELSE
MsgStr = "Error! Couldn't find `" & TblCode & "`!"
MSGBOX(MsgStr, vbOKOnly, "Error!") = "Code not found!"
END IF

tblRead.Close ' release memory used by the recordset

` Verify that you found the code, ELSE send back a flag
IF TempCode = TblCode Then
' Combine the 3 with ";" and "/" as separators into one value.
GetTableName = TempTableStr & ";" & tempIDFldStr & "/" & tempNameFldStr
ELSE
GetTableName = "000"

END IF

END FUNCTION

End of Listing 2

Listing 3

PRIVATE FUNCTION CalcNextIDNum(IDStr As String, ByVal ItemName) As String

**************************************************************************************
' Checks the ID numbers in the appropriate table to calculate an unique pair
' of digits for this ID code
**************************************************************************************
' Declare all variables before using them
DIM ThisDB As DATABASE
DIM tblRead As Recordset
DIM tempTableCode As String
DIM tempTableName As String
DIM tempIDStr As String
DIM tempNumStr As String
DIM tempNameStr As String
DIM tempIDFldStr As String
DIM tempNameFldStr As String
DIM SQLstr As String
DIM RecNum As Integer
DIM Num1 As Integer
DIM Num2 As Integer
DIM RecCount As Integer
DIM MsgStr As String
' Database, assumed open
' to hold recordset
' holds the table code
' holds table name
' hold test value while searching
' hold the last two digits
' hold the item name
' hold ID fieldname string
' hold name fieldname string
' hold SQL statement
' Record Counter for FOR Loop
' holds ";" position & tempNumStr
' holds "/" position & tempNumStr
' Record number & total records
' Holds Message

' Initialize variables
tempTableCode = "":
tempIDStr = """:
Num1 = 0:

tempTableName = "":
tempNumStr = "":
Num2 = 0

tempNameStr = """ tempNameFldStr = ""

tempTableCode = LEFT(IDStr, 1) ' Get the table code from the ID string

' IF nothing to work with, exit function
IF tempTableCode = "" THEN EXIT FUNCTION

' Identify the table
tempNameFldStr = GetTableName(tempTableCode)

MsgStr = "Error! Couldn't find `" & tempTableCode & "`!"
IF tempNameFldStr = "000" Then ' Inform user there's an error
IF MSGBOX(MsgStr, vbOKOnly, "Error!") = vbOK THEN Num1 = 0
EXIT FUNCTION
END IF

' A textual comparison starting at position 1 Returns position of ";"
' We're looking for the positions of ";" and "/"

Num1 = INSTR(1, tempNameFldStr, ";")
Num2 = INSTR(Num1, tempNameFldStr, "/")

' Extract the table name
tempTableName = LEFT$(tempNameFldStr, Num1 - 1)

' Extract ID field name
tempIDFldStr = MID$(tempNameFldStr, (Num1 + 1), ((Num2 - 1) - Num1))

' Extract Name fieldname
tempNameFldStr = Right$(tempNameFldStr, LEN(tempNameFldStr) - Num2)

'Create an SQL string using the variables extracted above. Notice how the variable names
' are combined with literals with the use of quotes and ampersands. The ampersand is used
' to concatenate strings (add one string to another).


' We're looking for only the table records with matching first 6 characters. So we're looking
' for ID strings with endings ' BETWEEN "00" and "99."

SQLstr = "SELECT DISTINCTROW " & tempTableName & "." & tempIDFldStr & _
", " & tempTableName & "." & tempNameFldStr & " FROM " & tempTableName & " _
WHERE (((" & tempTableName & "." & tempIDFldStr & ") BETWEEN `" & IDStr & _
"00' AND `" & IDStr & "99'));"

Set ThisDB = CurrentDb

' Here's how we use the SQL string
Set tblRead = ThisDB.OPENRECORDSET(SQLstr)

IF tblRead.BOF Then ' IF beginning of file it's empty
tblRead.Close
CalcNextIDNum = IDStr & "00"
EXIT FUNCTION

' this is the first
' Our work is finished
END IF

' Determine total number of records
tblRead.MoveLast
RecCount = tblRead.RecordCount
tblRead.MoveFirst
' move to last record
' then get record number
' return to beginning

' Reinitialize temp number holders to recycle the variables
Num1 = 0:
Num2 = 0

' Cycle through the recordset to find a name match or to find the highest ending digits
For RecNum = 1 To RecCount
tempIDStr = LEFT(tblRead.Fields(tempIDFldStr), 6)
tempNumStr = RIGHT(tblRead.Fields(tempIDFldStr), 2)

' convert string to a number
Num2 = VAL(tempNumStr)

' find the highest number
IF Num1 < Num2 Then Num1 = Num2
tempNameStr = tblRead.Fields(tempNameFldStr)
IF tempNameStr = ItemName Then
' It's not a new name so use the ID in the table
CalcNextIDNum = tblRead.Fields(tempIDFldStr)
tblRead.Close

' Our work is finished
EXIT FUNCTION
Num2 = VAL(tempNumStr)
END IF

' Move to the next record if there is one
IF RecNum < RecCount Then tblRead.MoveNext
NEXT RecNum

tblRead.Close ' release memory used by tblRead

' Increment the highest number in the record set stored in Num1
Num1 = Num1 + 1

' FORMAT() converts a number to a string without left padding with a space
' as does the STR() function.
tempNumStr = FORMAT(Num1)
IF LEN(tempNumStr) < 2 Then tempNumStr = "0" & tempNumStr

CalcNextIDNum = IDStr & tempNumStr

END FUNCTION


End of Listing 3

Listing 4


PRIVATE FUNCTION GetTheDigit(Letter) As String

' **********************************************************
' Convert a letter to a digit character string
' **********************************************************
DIM temp As String

SELECT CASE Letter
CASE "A" To "C" :
CASE "D" To "F" :
CASE "G" To "I" :
CASE "J" To "L" :
CASE "M" To "O" :
CASE "P" To "R" :
CASE "S" To "T" :
CASE "U" To "W" :
CASE "X" To "Z" :
CASE Else: 		temp = "1"
temp = "2"
temp = "3"
temp = "4"
temp = "5"
temp = "6"
temp = "7"
temp = "8"
temp = "9"
temp = Letter
END SELECT

GetTheDigit = temp ' Assign the result to the function name

END FUNCTION


End of Listing 4


Listing 5

Private Function StripIllegalChrs(ByVal Name As String) As String

' **********************************************************
' Strip all nonalpha-numeric characters from Name
' **********************************************************
Dim Iname As String
Dim Iname2 As String
Dim Ch As String
Dim I As Integer 		' Preservs an original copy of Name
' Holds a copy of Name to work with
' Character extracted from Iname
' Index integer for FOR loop

Iname = Name : Iname2 ="" ' Protect Name by working with copies

' Process every character
For I = 1 to Len(Iname)
Ch = Mid$(Iname, I 1)
SELECT CASE Ch
Case Chr(48) to Chr(57) :
Case Chr(65) to Chr(90) :
Case Chr(97) to (122) :
Case Else :
Iname2 = Iname2 & Ch
Iname2 = Iname2 & Ch
Iname2 = Iname2 & Ch
Iname2 = Iname2
' 0 to 9
' A to Z
' a to z
' illegal - add nothing
END SELECT

Next I

StripIllegalChrs = UCase(Iname2) ' Assign result to function name

END FUNCTION


End of Listing 5


Open the Manufacturers Entry / Edit form in design view. The first thing we will do is make a new field that will be tied to the CalcIDCode function, but not to the Manufacturers table. Select the Mailing Address label and shift click the MfgMailAddress text box. Copy and paste. The copy will appear in the upper left corner of the form. If it is not selected, select both and be sure your cursor turns into a mitt. Then drag it to the upper right side of the form. Make the top properties the same as the top of the MfgID text box. It will look better if you place it so the left sides align with the objects you just copied.

Now, change the caption of the label to Calculated Mfg ID and the name of the text box to CalculatedID. Click the Other tab of the text box property sheet to find the Name property. Click the Data tab and enter the following code in the Control Source property:

=CalcIDCode([MfgName],"M")

This line calls the function by that name and sends the value in the MfgName field and the table code "M" along for the function to use for its calculations.

Select the MfgID text box. Click the Events tab. Click the space next to On Dbl Click. Click the button with the ellipsis on the right border. This opens the Macro builder.

Under the Action heading click the down pointing arrow to open the list box. Scroll down to find "SetValue" and select it. Click and the list box closes. In the comment column type something like "Sets the value of MfgID to the value of CalculatedID on Manufacturers Entry / Edit Form."

In the Item field type [MfgID] and type [CalculatedID] in the Expression field. Save the macro as CalcMfgID. Microsoft Access should enter the macro name for you. If it doesn't click the down arrow and select it from the list presented. If it's not on the list, you probably forgot to save it, or used a different name when you did.

I didn't tie the CalcIDCode function directly to MfgID for a couple of reasons. 1. This could change an ID code after it has been entered as a reference in another table. and 2. This gives the user control over whether or not to use the calculated ID. If for some reason the calculated ID is invalid, for instance if there is reason to include the manufacturer in the table twice, with a different address maybe, then the user can do the research and enter a valid code for the second record. Another problem could possibly occur, though unlikely, you might have more than 99 names with the same first 5 characters. If that happens the user would have to change that first digit to another digit.

Add a label to the right of MfgID text box and give it a caption to let users know they can double click on the text box to change the value to the calculated ID. There's only space for something like "Dbl click for calc ID." You can add it to the description of MfgID in the design view of Manufacturers table. That appears as a prompt in the status bar at the bottom of the Microsoft Access screen.

Now you're ready to test your work. Open the form and enter some names. Be sure to enter some names with the same first five characters so the program will calculate codes with only the last two digits different. Make sure they increment by one each time. Be sure the ID for a unique name ends with "00." Enter some names with some spaces in the first 5 characters. Enter some names with numbers in the first 5 digits.

Return to Beginning
Continue
Previous
This document authored by Pat Tyler
Copyright July 1997