From the Audimation Website the code to create a running total:
'***********************************************************************************************
'IScript : RUNIND.ISS
'Version : 2nd November 1999
'Author : Peter Mitcham, Horwath Software Services
'Description : This file produces a running total for an indexed field
'Input File : Any file with atleast one numeric field - The file must be open
'Disclaimer : This script is provided as is without any warranties.
'***********************************************************************************************
'This Ideascript creates a new file and adds a numeric field called running total to the file
'The new field creates a running total for the numeric field using a specified index
'The new field then produces a running total for each different item within the index.
Option Explicit
Sub Main
' Get the current database object
On Error GoTo errHandler
DIM task as Object 'task object
DIM oldDB as Object 'original database object
DIM oldTable as Object 'original database table definition object
DIM oldRS as Object 'original database record set object
DIM oldRec as Object 'original database record object
DIM oldField as Object 'original database field object
DIM newDB as Object 'new database object
DIM strNewdbname as String 'filename for new database
DIM strNewdbdesc as String 'description of new database
DIM newTable as Object 'new database table definition object
DIM newRec as Object 'new database record object
DIM newRS as Object 'new database record set object
Dim extDB as Object 'extracted database object
DIM newFld as Object 'new database field object
DIM lngN as Long 'used to count the number of fields being transfered to new file
DIM lngI as Long 'used to count the number of fields in original database table definition for indexes
DIM dblNumcalc as Double 'value from field which is being totalled
DIM dblNumstrat as Double 'accumulated value for field being totalled
DIM strField as String 'string from index field cell
DIM strIndexfld as String 'string from previous cell of index field
DIM strMsg1 as String 'message string for opening msgbox
DIM varResponse1 as Variant 'response from opening msgbox
DIM strTitle as String 'title for dialog box
DIM arrFields (25) as string 'stores all numeric fields from original file - to be used for field to total
DIM arrIndexes (25) as string 'stores all fields from original file - to be used for list of fields to index
DIM IntIndCmd as integer 'response from Index dialog box
DIM IntTotCmd as integer 'response from Total dialog box
DIM intCount as integer 'count through loops
DIM lngF as long 'used to count the number of fields in original database table definition for fields
DIM strFieldname as string 'selected fieldname from original file to be used for field to total
DIM strRunindex as string 'selected fieldname from original file to be used for field to index
DIM percentComplete as Object
DIM dbfieldname as string
DIM oldname as String
DIM newname as String
DIM FileExplorer As Object
DIM DbName As String
Set FileExplorer=CreateObject("IDEAEx.FileExplorer")
FileExplorer.WorkingDirectory= Client.WorkingDirectory
Do while dbname = ""
call FileExplorer.DisplayDialog
dbName=FileExplorer.SelectedFile
If dbName="" Then
Dim valret as integer
valret = Msgbox ("You have not selected a file, do you want to select one?", MB_YESNO)
If valret = 7 then
Exit sub
End if
Else
Set OldDB = Client.Opendatabase(dbname)
' Since the new database will be based on this database, get it's table definition
Set oldTable = oldDB.TableDef
Set oldRS = oldDB.RecordSet
Set oldRec = oldRS.ActiveRecord
Set newtable = Client.Newtabledef
newTable.CopyFrom oldTable
'Add a field to the new file
dbfieldname = "RUN_TOTAL"
Set Newfld = newTable.NewField
Newfld.Name = dbFieldname
Newfld.Description = ("Running total using specified field as index")
Newfld.Type = WI_NUM_FIELD
Newfld.Length = 15
Newfld.Decimals = 2
NewTable.AppendField Newfld
' So we can iterate through the database, get it's record set and active record object
strNewdbName = Client.UniqueFileName ("RUN")
Set newDB = Client.NewDatabase (strNewdbname ,"", newTable)
Set newRS = newdb.recordset
Set newRec = newRS.Newrecord
Set newtable = newdb.tabledef
newtable.Protect = FALSE
Begin Dialog DIALOG1 49,47, 142, 129, "Cumulative Totals Add-in Script"
DropListBox 4,12,128,80, arrindexes(), .ListofIndexes
Text 4,4,128,8, "Select a Key field for breaks:"
PushButton 52,100,40,12, "Next", .Next
PushButton 4,100,40,12, "Cancel", .Exit
PushButton 92,100,40,12, "Help", .Help1
Text 4,116,100,8, "(c) Horwath Software Services"
End Dialog
Begin Dialog DIALOG2 49,47, 142, 129, "Cumulative Totals Add-in Script"
DropListBox 4,12,128,80, arrFields(), .ListofFields
Text 4,4,128,8, "Pick a Numeric Field to accumulate running totals:"
PushButton 52,100,40,12, "Finish", .Finish
PushButton 92,100,40,12, "Help", .Help2
PushButton 4,100,40,12, "Back", .Back
Text 4,116,100,8, "(c) Horwath Software Services"
End Dialog
strTitle = "Cummulative Totals Add-in Script"
strMsg1 = "Have you opened up the correct database? If so, press YES, otherwise, press NO"
varResponse1 = MsgBox (strMsg1, MB_YESNO,strTitle)
If varResponse1 = IDNO Then
Exit Sub
End If
Do While IntIndCmd <> 2
DIM IndexFields as DIALOG1
IntCount = 0
'count through the fields in the database and add to array
For LngI = 1 to oldTable.Count
Set oldField = oldTable.GetFieldAt (LngI)
arrIndexes(intCount) = oldField.Name
intCount = intCount + 1
Next LngI
IntIndCmd = Dialog(IndexFields)
If IntIndCmd = 1 then
'store selected field from dialog 1 into variable
strRunindex = arrIndexes(IndexFields.ListofIndexes)
IntTotCmd = 0
Do While IntTotCmd <> 3
Dim TotalFields as DIALOG2
IntCount = 0
'count through fields in database and put numeric field types into array
For lngF = 1 to oldTable.Count
Set oldField = oldTable.GetFieldAt (lngF)
If oldField.IsNumeric = TRUE then
arrFields(intCount) = oldField.Name
intCount = intCount + 1
End If
Next lngF
IntTotCmd = Dialog(TotalFields)
If IntTotCmd = 1 then
oldrs.AddKey strrunindex, "A"
'store selected field from dialog 1 into variable
set percentComplete = CreateObject ("CommonIdeaControls.StandAloneProgressCtl")
strFieldname = arrFields(TotalFields.ListofFields)
'copy each record in the primary database to the new database
percentComplete.Start "Running Total"
oldRS.ToFirst
For LngI = 1 to oldRS.Count
percentComplete.Progress Int(LngI * 100 / olddb.count)
oldRS.Next
'for each of the fields in the primary database, get the field object
For LngN = 1 to oldTable.Count
Set oldField = oldTable.GetFieldAt (lngN)
'dont try and set the contents of a virtual field
If Not(oldField.IsVirtual) Then
'copy the data over
If oldField.IsNumeric Then
newRec.SetNumValueAt lngN, oldRec.GetNumValueAt (LngN)
Elseif oldfield.IsCharacter then
newRec.SetCharValueAt lngN, oldRec.GetCharValueAt (LngN)
Elseif oldfield.IsDate then
newRec.SetDateValueAt lngN, oldRec.GetDateValueAt (LngN)
End If
End if
Next LngN
'populate variable with value from index field
strField=newRec.GetCharValue(strRunindex)
'test to see if current index field value = previous value
If strField <> strIndexfld Then
strIndexfld = strField
dblNumcalc=newRec.GetNumValue(strFieldname)
dblNumstrat = Empty
dblNumstrat = dblNumcalc
newRec.SetNumValue dbfieldname, dblNumstrat
Else
dblNumcalc=newRec.GetNumValue(strFieldname)
dblNumstrat = dblNumstrat + dblNumcalc
newRec.SetNumValue dbfieldname, dblNumstrat
End If
newRS.AppendRecord newRec
newrec.clearrecord
Next Lngl
Set task = newDB.History()
task.NewTask "File with accumlative total"
task.AppendDatabaseInfo
task.AppendText "Description", "Database imported from another file"
task.AppendText "Number of records:", olddb.count
Set task = Nothing
newtable.protect = true
'Save the database
newDB.Commitdatabase
Set newDB = Nothing
Set newRS = Nothing
Set newTable = Nothing
Set oldRS = Nothing
Set oldTable = Nothing
'open the database
Set extDB = Client.OpenDatabase(StrNewdbname)
Set OldDb = Nothing
Exit Sub
Elseif IntTotCmd = 2 then
Dim IntResp1 as Integer
IntResp1 = MsgBox ("The script creates a new file with an extra field containing a cumulative total of the field selected here, Please choose a suitable numeric field.", 64, "Help - Select numeric field")
Elseif IntTotCmd = 3 then
IntIndCmd = 0
End If
Loop
Elseif IntIndCmd = 3 then
Dim IntResp as Integer
IntResp = MsgBox ("The script computes the cumulative values of a numeric field and resets back to zero each time the key field changes. Choose a key such as Account Number or Customer Number where you want the reset to occur.", 64, "Help - Select Key Field")
End if
Loop
End if
Loop
Exit Sub
errHandler:
DIM ErrMsg as String
DIM ErrResp as integer
DIM ErrTitle as String
If Client.ErrorCode > 0 Then
If Client.ErrorCode = 1 then
'if no database is open, return this message
ErrMsg = "Error: " & Client.ErrorString & ", Please open a database and re-run the add-in"
ErrTitle = "Database Open Error"
End if
End If
ErrResp = MsgBox(ErrMsg, 16, ErrTitle)
If ErrResp = IDOK Then
Exit Sub
End If
Resume Next
End Sub