Dim ListBox1$() Begin Dialog dlgMenu 23,16,224,243,"Menu", .DisplayIt PushButton 24,14,40,14, "Select File", .PushButton1 Text 72,12,128,14, "Text", .txtFilename Text 24,42,52,11, "Amount Field", .Text1 DropListBox 24,60,157,10, ListBox1$(), .DropListBox1 Text 24,89,40,14, "Amount:", .Text2 TextBox 73,88,83,14, .txtAmount GroupBox 24,116,154,36, "Extraction Type", .groupExtractType OptionGroup .groupExtractType OptionButton 30,129,40,14, ">=", .OptionButton1 OptionButton 81,129,40,14, "<=", .OptionButton2 Text 24,163,40,14, "New Filename", .Text3 TextBox 72,163,108,14, .txtNewFilename OKButton 27,194,40,14, "OK", .OKButton1 CancelButton 85,194,40,14, "Cancel", .CancelButton1 End Dialog Option Explicit Dim filename As String Dim amountField As String Dim amount As String Dim extractionType As Boolean Dim newFilename As String Dim working_directory As String Dim exitScript As Boolean Sub Main working_directory = Client.WorkingDirectory Call menu() If Not exitScript Then 'Call DirectExtraction() 'Sample-Bank Transactions.IMD End If End Sub Function menu() Dim dlg As dlgMenu Dim button As Integer Dim filebar As Object Dim exitDialog As Boolean Dim source As Object Dim table As Object Dim fields As Integer Dim i, j As Integer Dim field As Object Do button = Dialog(dlg) Select Case button Case -1 'ok button If dlg.DropListBox1 > -1 Then amountField = ListBox1$(dlg.DropListBox1) Else amountField = "" End If extractionType = dlg.groupExtractType amount = dlg.txtAmount newFilename = dlg.txtNewFilename If validateMenu() Then exitDialog = TRUE Case 0 ' cancel button exitDialog = TRUE exitScript = TRUE Case 1'filename select button Set filebar = CreateObject("ideaex.fileexplorer") filebar.displaydialog filename = filebar.selectedfile If filename <> "" Then Set source = client.opendatabase(filename) Set table = source.tabledef fields = table.count ReDim ListBox1$(fields) j = 0 For i = 1 To fields Set field = table.getfieldat(i) If field.isnumeric Then ListBox1$(j) = field.name j = j + 1 End If Next i End If If j = 0 Then MsgBox "The file selected does not contain a numeric field", MB_ICONEXCLAMATION, "Error" filename = "" End If End Select Loop While exitDialog = FALSE Set source = Nothing Set table = Nothing Set field = Nothing End Function Function validateMenu() As Boolean validateMenu = TRUE If filename = "" Then MsgBox "Please select a file", MB_ICONEXCLAMATION, "Error" validateMenu = FALSE ElseIf amountField = "" Then MsgBox "Please select an amount field", MB_ICONEXCLAMATION, "Error" validateMenu = FALSE End If If newFilename = "" Then MsgBox "Please enter a new filename", MB_ICONEXCLAMATION, "Error" validateMenu = FALSE End If If checkForSpecialChar(newFilename, "\/:*?""<>[]|") Then MsgBox "Please do not use the following in your filename - \/:*?""<>[]|", MB_ICONEXCLAMATION, "Error" validateMenu = false End If If amount = "" Then MsgBox "Please enter an amount", MB_ICONEXCLAMATION, "Error" validateMenu = FALSE End If If Not IsNumeric(amount) Then MsgBox "Please enter a proper amount", MB_ICONEXCLAMATION, "Error" validateMenu = FALSE End If End Function Function checkForSpecialChar(temp_string As String, temp_list As String) As Boolean Dim strLen As Integer Dim tempChar As String Dim i As Integer Dim pos As Integer checkForSpecialChar = FALSE strlen = Len(temp_list) For i = 1 To strLen tempChar = Mid(temp_list, i, 1) pos = InStr(1, temp_string, tempChar) If pos > 0 Then checkForSpecialChar = TRUE End If Next i End Function ' Data: Direct Extraction Function DirectExtraction Dim db As database Dim task As task Dim dbName As String Set db = Client.OpenDatabase("Sample-Bank Transactions.IMD") Set task = db.Extraction task.IncludeAllFields dbName = "amount greater than 10.IMD" task.AddExtraction dbName, "", "AMOUNT >= 10 " task.CreateVirtualDatabase = False task.PerformTask 1, db.Count Set task = Nothing Set db = Nothing Client.OpenDatabase (dbName) End Function Function DisplayIt(ControlID$, Action%, SuppValue%) If filename = "" Then DlgText "txtFilename", "No file selected" Else DlgText "txtFilename", "File: " & getFileName(filename, 0) End If End Function Function getFileName(temp_filename As String, temp_type As Boolean) '1 if get the name with any folder info, 0 if only the name Dim temp_length As Integer Dim temp_len_wd As Integer Dim temp_difference As Integer Dim temp_char As String Dim tempfilename As String If temp_type Then temp_len_wd = Len(working_directory ) + 1'get the lenght of the working directory temp_length = Len(temp_filename) 'get the lenght of the file along with the working directory temp_difference = temp_length - temp_len_wd + 1'get the lenght of just the filename getFileName = Mid(temp_filename, temp_len_wd, temp_difference) Else temp_length = Len(temp_filename ) Do temp_char = Mid(temp_filename, temp_length , 1) temp_length = temp_length - 1 If temp_char <> "\" Then tempfilename = temp_char & tempfilename End If Loop Until temp_char = "\" Or temp_length = 0 getFileName = tempfilename End If End Function