Accumulated Total and JE Number
Forums
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
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.
Any chance you can attach the
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