Accumulated Total and JE Number

11 posts / 0 new
Last post
ecas_hamilton
Offline
Joined: 05/23/2013 - 13:46
Accumulated Total and JE Number

I am trying to run a script that somebody else developed that creates an accumulated total field based on a user defined database and amount field and index and then create a journal number based on each set of transactions that the accumulated total nets to zero.
I am received the following error message "Error Code # 51, No cell Information", folowed by "Error on line 5999, No valid working directory"
Code is below. Any thoughts or sugesstions?  This macro was developed in 2011 (not sure what IDEA version). I'm trying to execute in IDEA 9. Note I did not include first 34 lines as these just explained what macro is supposed to do.
Sub Main ' Variable declarations ' Database objects needed from active DB
 Dim task    As Object           'Task for creation of database history Dim oldDB    As Object           'Old Database  object Dim oldTable    As Object           'Old Tabledef  object Dim oldRS    As Object           'Old Recordset object Dim oldRec    As Object           'Old Record    object Dim oldField    As Object           'Old Field     object ' Database objects needed to create the new DB
 Dim newDB    As Object           'New Database  object Dim newDBName   As String           'New Databse   name Dim newDBDesc    As String           'New Database  description   Dim newTable    As Object           'New Tabledef  object Dim newRec    As Object           'New Record    object Dim newRS    As Object           'New Recordset object ' Declarations for the File Explorer and Progress bar
 Dim percentComplete   As Object           'Progress bar object         Dim filename    As String           'Name of file selected in File Explorer Dim filebar    As Object           'File Explorer object
' Declare variable regarding the Select Database dialog box
 Dim pm     As Object  Dim coll     As Object Dim numofdb     As Integer   Dim extDB    As Object           'Object to open newly created Database Dim fld     As Object           'Add a field to the new table def object Dim n     As Long            'Loop subscript Dim i     As Long            'Loop subscript Dim numval    As Double           'Value to transfer from old DB to new DB Dim charval    As String           'IBID  Dim Fieldtype()    As String  Dim Ftype    As String Dim total    As Double           'Variable to hold cummulative values Dim NumFields    As Integer           'Number of fields in the table Dim j     As Integer            'Value of the listbox selection Dim ThisFieldName   As String           'Name of the field Dim ThisField    As String Dim Button    As Integer Dim Button2    As Integer Dim SelectField    As String             'Name of the field selected in the first Dialog Dim SelectField2    As String Dim SelectField3    As String Dim SelectField4    As String Dim SelectField5    As String  Dim SelectField6    As String Dim SelectField7    As String  Dim amtField    As Double Dim dblNumstrat    As Double Dim dblNumcalc    As Double Dim strField    As String Dim selectfld    As String  On Error GoTo errHandler '**********************Main Logic*******************************
ChooseDatabase: ' Access project management object to manage databases/projects on server
 Set pm = Client.ProjectManagement
' Set the coll object to be the databases within the current project   Set coll = pm.Databases  ' Get total count of databases  numofdb = coll.count
 ReDim temp(numofdb+1)
 temp(0) = "Current Open (Active) Database"  ' Iterate throught the coll to get the database names
 For i = 1 To coll.count   temp(i) = coll.getAt(i-1) Next i
' Display the list of databases
 Dim Dlg1 As SelectDatabase Button = Dialog(Dlg1)
' If user chooses OK then capture field choice  If Button = -1 Then  i =  SelectDatabase.DropListBox1  filename = temp(i) Else  Exit Sub End If ' Current Open Database Selection and Open the database
 If filename = "Current Open (Active) Database" Then  filename = ireplace(client.currentdatabase.name,client.workingdirectory,"")  Set olddb = client.currentdatabase Else  Set olddb = client.opendatabase(filename)        'Open file that was selected in the file explorer End If
' Set variables  total = 0                'Set our cummulative value to 0
' Create a table of field names  Set table = olddb.tabledef  Numfields = table.count ReDim NumericFields(NumFields) ReDim NumericFields2(NumFields) ReDim NumericFields3(NumFields+1) ReDim NumericFields4(NumFields+1) ReDim NumericFields5(NumFields+1) ReDim NumericFields6(NumFields+1) ReDim NumericFields7(NumFields+1) ReDim FieldType(NumFields)
'**********************End Main Logic******************************* '****************DIALOG 1***********************************************
ChooseAmountField:
j=0 For i = 1 To numfields  Set ThisField = Table.GetFieldAt (i)  If ThisField.IsNumeric Then           ' If the field is numeric put it in the listbox   ThisFieldName = ThisField.Name   Numericfields(j) = ThisFieldName        'Set value for AllFields array   j=j+1  End If Next i
' Dialog Box to let user pick the field to be accumulated
 Dim Dlg2 As ChooseField Button1 = Dialog(Dlg2) ' If user chooses OK then capture field choice  If Button1 = -1 Then  j =  ChooseField.DropDown_1  SelectField = Numericfields(j) ElseIf Button1 = 1 Then  GoTo ChooseDatabase Else  Exit Sub End If
'**********************END DIALOG 1*************************************
'**********************DIALOG 2******************************************ChooseIndexFields:
 j=0 For i = 1 To numfields  Set ThisField = Table.GetFieldAt (i)'      If Not(ThisField.IsVirtual) Then     ' If the field is Virtual  do not put it in the listbox   ThisFieldName     = ThisField.Name   ftype             = Thisfield.type   Fieldtype(j)      = ftype   Numericfields2(j) = ThisFieldName  'Set value for AllFields array   j=j+1'    End If Next i
 Numericfields3(0) = "NOT APPLICABLE"  j=1 For i = 1 To numfields  Set ThisField = Table.GetFieldAt (i)'      If Not(ThisField.IsVirtual) Then     ' If the field is Virtual  do not put it in the listbox   ThisFieldName     = ThisField.Name   ftype             = Thisfield.type   Fieldtype(j)      = ftype   Numericfields3(j) = ThisFieldName  'Set value for AllFields array   j=j+1'    End If Next i
 Numericfields4(0) = "NOT APPLICABLE"  j=1 For i = 1 To numfields  Set ThisField = Table.GetFieldAt (i)'      If Not(ThisField.IsVirtual) Then     ' If the field is Virtual  do not put it in the listbox   ThisFieldName     = ThisField.Name   ftype             = Thisfield.type   Fieldtype(j)      = ftype   Numericfields4(j) = ThisFieldName  'Set value for AllFields array   j=j+1'    End If Next i
 Numericfields5(0) = "NOT APPLICABLE"  j=1 For i = 1 To numfields  Set ThisField = Table.GetFieldAt (i)'      If Not(ThisField.IsVirtual) Then     ' If the field is Virtual  do not put it in the listbox   ThisFieldName     = ThisField.Name   ftype             = Thisfield.type   Fieldtype(j)      = ftype   Numericfields5(j) = ThisFieldName  'Set value for AllFields array   j=j+1'    End If Next i  Numericfields6(0) = "NOT APPLICABLE"  j=1 For i = 1 To numfields  Set ThisField = Table.GetFieldAt (i)'      If Not(ThisField.IsVirtual) Then     ' If the field is Virtual  do not put it in the listbox   ThisFieldName     = ThisField.Name   ftype             = Thisfield.type   Fieldtype(j)      = ftype   Numericfields6(j) = ThisFieldName  'Set value for AllFields array   j=j+1'    End If Next i
 Numericfields7(0) = "NOT APPLICABLE"  j=1 For i = 1 To numfields  Set ThisField = Table.GetFieldAt (i)'      If Not(ThisField.IsVirtual) Then     ' If the field is Virtual  do not put it in the listbox   ThisFieldName     = ThisField.Name   ftype             = Thisfield.type   Fieldtype(j)      = ftype   Numericfields7(j) = ThisFieldName  'Set value for AllFields array   j=j+1'    End If Next i  ' Dialog Box to let user pick the field to be accumulated
 Dim Dlg3 As ChooseIndex Button2 = Dialog(Dlg3) ' If user chooses OK then capture field choice
 If Button2 = -1 Then  j =  ChooseIndex.DropDown_2  SelectField2 = Numericfields2(j)  j =  ChooseIndex.DropDown_3  SelectField3 = Numericfields3(j)  j =  ChooseIndex.DropDown_4  SelectField4 = Numericfields4(j)  j =  ChooseIndex.DropDown_5  SelectField5 = Numericfields5(j)  j =  ChooseIndex.DropDown_6  SelectField6 = Numericfields6(j)  j =  ChooseIndex.DropDown_7  SelectField7 = Numericfields7(j)
 ElseIf Button2 = 1 Then  GoTo ChooseAmountField Else  Exit Sub End If
'*************************END DIALOG 2*****************************
 
 
' Since the new database will be based on the old database, get it's table definition
 Set oldTable       = oldDB.TableDef     Set oldRS          = oldDB.RecordSet Set newTable          = Client.NewTableDef newTable.CopyFrom oldTable ' Add Running Balance field
 Set fld               = newTable.NewField     fld.Name         = "Running_Bal"     fld.Description   = "Running Balance calculated"     fld.Type          = WI_NUM_FIELD     fld.Decimals      = 2  newTable.AppendField fld
' Add ECAS JE Num field
 Set fld               = newTable.NewField     fld.Name          = "ECAS_JE_Num"     fld.Description   = "ECAS created Journal Entry Number"     fld.Type         = WI_NUM_FIELD     fld.Decimals      = 0  newTable.AppendField fld
 
' Get Index fields
 Dim IndexFields As String  IndexFields = SelectField2 & ", " & SelectField3 & ", " & SelectField4 & ", " & SelectField5 & ", " & SelectField6 & ", " & SelectField7
 IndexFields = ireplace(IndexFields ,", NOT APPLICABLE" ,"")
' Create the new database  ' newDBName  = ireplace(filename,".IMD"," w ECAS JE Num WIP.IMD") newDBName  = ireplace(filename,".IMD"," Index - " & IndexFields & ".IMD") newDBName  = Client.UniqueFileName(newDBName) Set newDB         = Client.NewDatabase (newDBName ,"", newTable) Set newRS         = newDB.RecordSet Set newRec         = newRS.NewRecord Set newTable       = NewDb.TableDef NewTable.Protect  = FALSE
' Creating an instance of a Progress Bar
 Set percentComplete = CreateObject ("CommonIdeaControls.StandaloneProgressCtl") percentComplete.Start "Creating new Database"
 ' Set database index
 If SelectField2 <> "NOT APPLICABLE" Then oldrs.AddKey SelectField2, "A" End If  If SelectField3 <> "NOT APPLICABLE" Then oldrs.AddKey SelectField3, "A" End If
 If SelectField4 <> "NOT APPLICABLE" Then oldrs.AddKey SelectField4, "A" End If
 If SelectField5 <> "NOT APPLICABLE" Then oldrs.AddKey SelectField5, "A" End If
 If SelectField6 <> "NOT APPLICABLE" Then oldrs.AddKey SelectField6, "A" End If
 If SelectField7 <> "NOT APPLICABLE" Then oldrs.AddKey SelectField7, "A" End If   ' Copy each record in the primary database to the new database  oldRS.ToFirst  Set oldRec         = oldRS.ActiveRecord  JE = 1   For i = 1 To oldDB.Count  percentComplete.Progress Int(i * 100 / olddb.count)  ' Move to next record
  oldRS.Next
  ' For each of the fields in the primary database, get the field object     For n = 1 To oldTable.Count    Set oldField = oldTable.GetFieldAt (n)
    ' Don't try to set the contents of a virtual field     If oldField.IsVirtual = False  Then        ' Copy the data over      If oldField.IsNumeric Then       numval = oldrec.GetNumValueAt (n)        newrec.setNumValueAt n, numval      ElseIf oldfield.ischaracter Then       charval = oldrec.GetCharValueAt (n)       newrec.setcharvalueAt n, charval      Else       charval = oldrec.GetDateValueAt (n)       newrec.setdatevalueAt n, charval      End If     End If        Next n 
  amtfield = oldrec.GetNumValue (SelectField)  total = total + amtfield  newRec.SetNumValue "Running_Bal", total    newRec.SetNumValue "ECAS_JE_Num", JE    If Round(total,2) = 0.00 Then  JE = JE + 1  End If
  newRS.AppendRecord newRec  newrec.ClearRecord  Next i
'  Write out a history entry 
  Set task = newDB.History() task.NewTask "Created New Database" task.AppendDatabaseInfo task.AppendText "Description", "Created new database from GL database.  Added a Running Balance field and ECAS JE Num field." task.AppendText "New field", "Running_Bal and ECAS-JE_Num" task.AppendText "Index Fields", "" & IndexFields & "" task.AppendText "Records Written", olddb.count newDB.CommitDataBase
     Set extDB   = Client.OpenDatabase (newDBName)      Set Table    = extDb.TableDef Table.Protect    = True
 ' Index the database by Account Number and ECAS JE Num 
 Set db = Client.CurrentDatabase Set task = db.Index 'task.AddKey "ACCT_NUM", "A" task.AddKey "ECAS_JE_NUM", "A" task.Index TRUE Set task = Nothing
' Extract the database based on the new index
 Set task = db.Extraction task.IncludeAllFields 'task.AddKey "ACCT_NUM", "A" task.AddKey "ECAS_JE_NUM", "A" dbName = ireplace(filename,".IMD"," w JE Num.IMD") dbName = Client.UniqueFileName(dbname) task.AddExtraction dbName, "", "" task.PerformTask 1, db.Count Set task = Nothing Set db = Nothing Client.OpenDatabase (dbName)
' Remove the Running Balance Field
 Set db = Client.CurrentDatabase Set task = db.TableManagement task.RemoveField "RUNNING_BAL" task.PerformTask Set task = Nothing Set db = Nothing ' Summarize the GL by ECAS JE Num  Set db = Client.CurrentDatabase Set task = db.Summarization task.AddFieldToSummarize "ECAS_JE_NUM" task.AddFieldToTotal "" & SelectField & "" dbName = "KFS JE Num " & filename dbName = Client.UniqueFileName(dbname) task.OutputDBName = dbName task.CreatePercentField = FALSE task.StatisticsToInclude = SM_COUNT + SM_SUM task.PerformTask Set task = Nothing Set db = Nothing Client.OpenDatabase (dbName)
' Determine if all journal entries equal to zero. 
 Set db = Client.CurrentDatabase
 If db.FieldStats("" & SelectField & "_SUM").NumRecords = db.FieldStats("" & SelectField & "_SUM").NumZeroItems Then  button = MsgBox ("All ECAS Journal Entries balance to zero!"  & Chr(13) & _  Chr(13) & _  db.FieldStats("" & SelectField & "_SUM").NumRecords & " unique journal entry numbers were created." & Chr(13) & _  Chr(13) & _  "The " & filename & " database was indexed by the following fields:" & Chr(13) & _  Chr(13) & _   " " & ialltrim(ireplace(indexfields,",",Chr(13)))  & Chr(13) & _  Chr(13) & _  "Click on Retry to try another Index or Cancel to Exit the Script.", 69 , "Finished Script") Else  button = MsgBox  ("All ECAS Journal Entries DO NOT balance to zero!" & Chr(13) & _  Chr(13) & _  "The " & filename & " database was indexed by the following fields:" & Chr(13) & _  Chr(13) & _   " " & ialltrim(ireplace(indexfields,",",Chr(13)))  & Chr(13) & _  Chr(13) & _  "Click on Retry to try another Index or Cancel to Exit the Script.", 21, "**************   WARNING   **************") End If   If button = 4 Then GoTo chooseindexfields End If  GoTo ExitScript  errHandler:   If Client.ErrorCode > 0 Then   errMsg = "Error: " & Client.ErrorString  Else   errMsg = "Error #" & Str(Err.Number) & Chr$(13) & Err.Description & Chr$(13)  End If  Response = MsgBox(errMsg, MB_OK, "Error")
 ExitScript:   ' Close All Databases
 Client.CloseAll
' Refresh File Explorer
 Client.RefreshFileExplorer
 ' Clear the objects
 Set task    = Nothing Set newDB   = Nothing  Set newTable    = Nothing     Set newRec      = Nothing    Set newRS       = Nothing Set oldDB       = Nothing Set oldTable    = Nothing            Set oldRS       = Nothing           Set oldRec      = Nothing         Set oldField    = Nothing  Set taskIndex   = Nothing Set percentComplete  = Nothing  Set filebar            = Nothing   Set pm     = Nothing Set coll     = Nothing Set fld    = Nothing Set ThisField    = Nothing  Set db    = Nothing Set table   = Nothing Set extDB   = Nothing  ' Reset Working Folder
 folder = Client.WorkingDirectory Client.WorkingDirectory = folder
End Sub

Brian Element's picture
Brian Element
Offline
Joined: 07/11/2012 - 19:57

Any chance you can attach the script (or email it to me).  From what I can see it is probably is a v8 or older script.  You should have a place where you can upload the script.  Also when you do a copy you miss the code to create the dialog.

Thanks

Brian

ecas_hamilton
Offline
Joined: 05/23/2013 - 13:46

Script uploaded

Brian Element's picture
Brian Element
Offline
Joined: 07/11/2012 - 19:57

Thanks, it looks like it was probably written for V7 of IDEA.  So it doesn't suprise me that it doesn't work.  If I have time I will have a look at it in IDEA tonight.

Brian Element's picture
Brian Element
Offline
Joined: 07/11/2012 - 19:57

Hi, just to let you know I haven't forgotten about this but I have been away because of illness in the family.  Right now I am not sure when I will get a chance but things are slowly getting back to normal.

scotchy33
Offline
Joined: 09/05/2012 - 15:51

 
It appears IDEA 9 does not like adding new fields to a table being defined (blank table-only headers) so the work around was to create the fields utilized in the script in the primary database.  The fields are then deleted once the table is done being defined.  To see what I mean look at the attached jpg.  Modified scripts that work on v9 attached.  Working, but sloppy workaround...maybe there is a better one from Brian. 
 

Images: 
Brian Element's picture
Brian Element
Offline
Joined: 07/11/2012 - 19:57

That is interesting, I will have to test it out as I would think it would be allowed.

scotchy33
Offline
Joined: 09/05/2012 - 15:51

scripts

scotchy33
Offline
Joined: 09/05/2012 - 15:51

I tried to upload revised scripts but it doesn't seem to work?

Brian Element's picture
Brian Element
Offline
Joined: 07/11/2012 - 19:57

Hi Scotchy,

Do you want to try again (or email it to me).  I just saw that when you upload a file it will not show by default so that might have been the problem, I have changed the setting now.

Thanks

Brian

scotchy33
Offline
Joined: 09/05/2012 - 15:51

Try try again.  Files attached...hopefully.