Using listboxs to select files/fields

A common problem with IDEAScript is there is no easy way to select multiple files or fields.  This script shows you one way of performing this operation.  This is a working example script.  It has a main menu that allows you to open the listbox dialog.  The main menu also allows you to select which type of fields you want to display, when you select ok you will have a message box of the fields that you selected.  You can download the code.

When you start the script you will see the following dialog that allows you to select the file, which type of fields you want to select and select the listbox dialog.

Listbox Demo With Fields1

When you click on the select fields button you will have a dialog with will list the different fields and you can either select all of them or each one individually.

Listbox Demo With Fields2

When you exit the dialog you will be given a list of the fields you selected.

Listbox Demo With Fields3

You can download the script here.

Snippet: 
'********************************************************************************************************************************************
'* Script:	listbox demo with fields.iss
'* Author:	Brian Element - brian.element@ideascripting.com
'* Date:	April 4, 2014
'* Purpose:	This is a demo script to show how you can create a dialog to be able to select multiple files.  This is a working
'*		script that will allow you to select character, numeric, data, time and all fields from a selected file.  The end
'*		product is a message box with all the fields that you selected.  If you need this functionality you can use this
'*		script as the starting point for your own script.
'* This script is presented without any warranty or guarantee.  Users are encouraged to validate the effectiveness and reliability on their own.
'********************************************************************************************************************************************

Option Explicit
Public fields()
Dim sFilename As String
Dim iFieldType As Integer
Dim working_directory  As String
Dim bExitScript As Boolean 'flag in case user hits cancel, the script will be exited
Dim bFieldsSelected As Boolean 'flag to show if the fields have been selected.

Dim tempListbox1() As String 'needed for the variables for the dlgSeletFiles
Dim tempListBox2() As String 'needed for the variables for the dlgSeletFiles
Dim tempListSelect1 As Integer ' var to hold the last SuppValue before hitting the button - need as a global so it is remembered
Dim tempListSelect2 As Integer ' var to hold the last SuppValue before hitting the button - need as a global so it is remembered


Sub Main
	Dim i As Integer
	Dim sMsg As String
	Dim CrLf As String
	working_directory = Client.WorkingDirectory()
	CrLf = Chr(10) & Chr(13)
	Call menu()
	If Not bExitScript Then
		For i = 0 To UBound(tempListBox2)
			sMsg = sMsg & tempListBox2(i) & CrLf 
		Next i
		MsgBox sMsg
	End If
	

End Sub

Function funSelectFiles(ControlID$, Action%, SuppValue%)
	Dim bExitMenu As Boolean 'flag to indicate if the dialog should close or remain open
	Dim i As Integer
	Dim j As Integer
	Dim k, l As Integer 'used to update tempListbox1 and 2 array
	Dim bListBox2Set As Boolean 'flag to show item was in placed in listbox2
	Select Case action
		Case 1
			'initialize the variables
			ReDim tempListbox1(0) 
			ReDim tempListbox2(0)
			
			l = 0
			k = 0
			'takes the items from the fields array and places them in the tempListBox1 array and then place the contents in lisbox1
			For i = 0 To UBound(fields)
				ReDim Preserve tempListbox1(UBound(tempListbox1) + 1)
				If fields(i) <> "" Then
					tempListbox1(i) = fields(i) & "-" & i
				End If
			Next i
			Call sortArray(tempListbox1)
			Call removeBlanksFromArray(1)
			DlgListBoxArray "ListBox1", tempListbox1
			tempListSelect1 = 0  'set to 1st items as default
		Case 2
			Select Case ControlId$
				'this will take the item selected from listbox1 and add it to listbox2
				Case "PushButton1"
					ReDim Preserve tempListbox2(UBound(tempListbox2) + 1)
					
					tempListbox2(UBound(tempListbox2)) = tempListbox1(tempListSelect1)

					tempListbox1(tempListSelect1 ) = ""
					
					'sort and remove any blancks from the array
					Call sortArray(tempListbox1)
					Call sortArray(tempListbox2)
					Call removeBlanksFromArray(1)
					Call removeBlanksFromArray(2)
					
					'add the contents of tempListbox1 and 2 to the Listboxes
					DlgListBoxArray "ListBox2", tempListbox2()
					DlgListBoxArray "ListBox1", tempListbox1()
					
					tempListSelect1 = 0 'set to 1st items as default
					bExitMenu = FALSE 'don't close the dialog
				'this will take an item selected from lisbox2 and add it to listbox1
				Case "PushButton2"

					ReDim Preserve tempListbox1(UBound(tempListbox1) + 1)
					
					tempListbox1(UBound(tempListbox1)) = tempListbox2(tempListSelect2)

					tempListbox2(tempListSelect2 ) = ""
					
					'sort and remove any blanks from teh array
					Call sortArray(tempListbox1)
					Call sortArray(tempListbox2)
					Call removeBlanksFromArray(1)
					Call removeBlanksFromArray(2)
					
					'add the contents of tempListbox1 and 2 to the Listboxes
					DlgListBoxArray "ListBox2", tempListbox2()
					DlgListBoxArray "ListBox1", tempListbox1()
					
					tempListSelect2 = 0 'set to 1st items as default
					bExitMenu = FALSE 'don't close the dilaog
					
				'take all the items from listbox1 and place them in listbox2
				Case "PushButton3"
					ReDim tempListbox2(UBound(fields))
					ReDim tempListbox1(0)
					For i = 0 To UBound(fields)
						tempListbox2(i) = fields(i)
					Next i
					Call sortArray(tempListbox2)
					Call removeBlanksFromArray(2)
					
					'add the contents of tempListbox1 and 2 to the Listboxes
					DlgListBoxArray "ListBox2", tempListbox2()
					DlgListBoxArray "ListBox1", tempListbox1()
					bExitMenu = FALSE  'don't close the dilaog
				
				'take all the items from listbox2 and place them in listbox2
				Case "PushButton4"
					ReDim tempListbox1(UBound(fields))
					ReDim tempListbox2(0)
					For i = 0 To UBound(fields)
						tempListbox1(i) = fields(i)
					Next i
					Call sortArray(tempListbox1)
					Call removeBlanksFromArray(1)
					
					'add the contents of tempListbox1 and 2 to the Listboxes
					DlgListBoxArray "ListBox2", tempListbox2()
					DlgListBoxArray "ListBox1", tempListbox1()
					bExitMenu = FALSE  'don't close the dilaog
				'used to keep track of the values selected from the listbox1 and listbox2 when a button is selected
				Case "ListBox1"
					tempListSelect1 = SuppValue%
					
				Case "ListBox2"
					tempListSelect2 = SuppValue%
				
				'If okbutton is selected check to make sure one item has been selected, it no give a warning and don't close the dialog	
				Case "OKButton1"
					If  tempListbox2(0) = "" Then
						MsgBox "Please select at least one file"
						bExitMenu = FALSE
					Else
						bExitMenu = True
						bFieldsSelected = True
					End If
				'if the cancel button is selected then indicated that no fields have been selected
				Case "CancelButton1"
					bFieldsSelected = False 'no Fields selected
		End Select
	End Select
	
	'The following is used to enable the different buttons depending on the contents of the listboxes
	If tempListbox1(0) = "" Then 'firt list box is emtpy
		DlgEnable "PushButton1", 0
		DlgEnable "PushButton3", 0
		DlgEnable "PushButton2", 1
		DlgEnable "PushButton4", 1

	ElseIf tempListbox2(0) ="" Then 'second list box is empty
		DlgEnable "PushButton1", 1
		DlgEnable "PushButton3", 1
		DlgEnable "PushButton2", 0
		DlgEnable "PushButton4", 0

	Else 'something in boxes
		DlgEnable "PushButton1", 1
		DlgEnable "PushButton3", 1
		DlgEnable "PushButton2", 1
		DlgEnable "PushButton4", 1

	End If
	
	'close the dialog if bExitMenu is true
	If bExitMenu Then
		funSelectFiles = 0
	Else 
		funSelectFiles = 1
	End If
	
End Function

'funtion to call the menu.  It will check to see if a file is open, if so it will pass the file name to sFilename, if not sFilename will be blank and then open the dialog
Function menu()
	Dim dlg As mainMenu
	Dim button As Integer
	
	Dim db As database
		On Error Resume Next
		Set db = Client.CurrentDatabase()
		If err.number = 0 Then
			sFilename = db.name
		Else
			sFilename = ""
		End If
	
	Set db = Nothing
	
	button = Dialog(dlg)

End Function

'function for the mainMenu dialog
Function displayIt(ControlID$, Action%, SuppValue%)
	Dim bExitFun As Boolean
	Dim button As Integer
	Dim dlgSelectFilesDialog As dlgSelectFields
	Select Case action
		Case 1

		Case 2
		
			Select Case ControlId$
				'if PushButton1 selected then call the getFile function to obtain the filename
				Case "PushButton1"
					sFilename = getFile()
					bExitFun = false 'don't close the dialog
				'Call the dlgSelectedFields dialog.  It will first find which option was selected for the fields, then call the fields and then call the dialog
				Case "PushButton2"
					If sFilename <> "" Then
						'get the field types
						iFieldType = mainMenu.OptionButtonGroup1
						Call getFields()
						button = Dialog(dlgSelectFilesDialog)
					End If
				'if the user selected the cancel button close the dilaog and exit the script
				Case "CancelButton1"
					bExitFun = True
					bExitScript  = True
				'if the ok button is selected make sure that a file is selected and also the fields, if they aren't give an error and don't close the dialog, other wise close the dialog
				Case "OKButton1"
					If sFilename = "" Then
						MsgBox "Please select the file"
						bExitFun = FALSE
					ElseIf Not bFieldsSelected Then
						MsgBox "Please select the fields"
						bExitFun = FALSE
					Else		
						bExitFun = True
					End If

					
			End Select
		End Select
	
	'Place the filename in the Text1 textbox of give an indication that the file had not been selected	
	If sFilename = "" Then
		DlgText "Text1", "Please select a file"
	Else
		DlgText "Text1", getFileName(sFilename, 0)
	End If
	
	'Place a message in the Text2 textbox indicating if the fields have been selected or not
	If bFieldsSelected Then
		DlgText "Text2", "Fields selected"
	Else
		DlgText "Text2", "Please select the fields"
	End If
	
	'if bExitFun is true then close the dialog, otherwise keep it open
	If bExitFun Then
		displayIt = 0
	Else 
		displayIt = 1
	End If


End Function

'this function will ge tthe filename from a path
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

'function to open the FileExplorer and return the name of the file selected
Function getFile()
               Dim filebar As Object
               Set filebar =CreateObject ("ideaex.FileExplorer")
               ' Display the File Explorer
               filebar.DisplayDialog
               ' Set Variable to store Select File Name
               getFile = filebar.SelectedFile
End Function

'function to sort an array
Private Function sortArray(MyArray() As String)
	Dim lLoop, lLoop2 As Integer
	Dim str1, str2 As String
	For lLoop = 0 To UBound(MyArray)
	
		For lLoop2 = lLoop To UBound(MyArray)
		
			If UCase(MyArray(lLoop2)) < UCase(MyArray(lLoop)) Then
			
				str1 = MyArray(lLoop)
				str2 = MyArray(lLoop2)
				MyArray(lLoop) = str2
				MyArray(lLoop2) = str1
			
			End If
		
		Next lLoop2
	
	Next lLoop

End Function

'function to get the fields from an IDEA file.  There are different options in that the user can selected to obtain all, char, num, date or time fields
Function getFields()
	Dim oSource As database
	Dim oTable As table
	Dim oField As field
	Dim iFields As Integer
	Dim i As Integer  
               	
	If sFilename<> "" Then
		Set oSource=client.opendatabase(sFilename)
			Set oTable=oSource.tabledef
				iFields=oTable.count
				
				ReDim fields(iFields - 1)
				
				For i=1 To iFields 
				
					Set oField=oTable.getfieldat(i)
					
					If oField.IsCharacter And iFieldType = 0 Then
						fields(i - 1)=oField.name
					ElseIf oField.IsNumeric And iFieldType = 1 Then
						fields(i - 1)=oField.name
					ElseIf oField.IsDate And iFieldType = 2 Then
						fields(i - 1)=oField.name
					ElseIf oField.IsTime And iFieldType = 3 Then
						fields(i - 1)=oField.name
					ElseIf iFieldType = 4 Then
						fields(i - 1)=oField.name
					End If
				Next i
				
				
				Set oField = Nothing
			Set oTable = Nothing
		Set oSource = Nothing
	End If
End Function

'****************************************************************************************************
'	Name:		removeBlanksFromArray
'	Description:	Routine to remove blank entries to an array
'	Last Update:	
'****************************************************************************************************
Private Function removeBlanksFromArray(tempType As Integer)
	Dim tempArray() As String
	Dim i, ILoop As Integer
	ReDim tempArray(0)
	
	If tempType = 1 Then
		For ILoop = 0 To UBound(tempListbox1)
			If tempListbox1(ILoop) <> "" Then
				tempArray(UBound(tempArray)) = tempListbox1(ILoop) 
				If ILoop <> UBound(tempListBox1) Then 'don't increment on the last pass
					ReDim preserve tempArray(UBound(tempArray) + 1)
				End If
			End If
		Next ILoop
		'MsgBox UBound(MyArray)
		i = UBound(tempArray)
		Erase tempListbox1
	
		ReDim tempListbox1(i)
		For ILoop = 0 To UBound(tempArray)
			'MsgBox "i " & ILoop & " - " & tempArray(ILoop)
			tempListbox1(ILoop) = tempArray(ILoop) 
		Next ILoop
	Else
		For ILoop = 0 To UBound(tempListbox2)
			If tempListbox2(ILoop) <> "" Then
				tempArray(UBound(tempArray)) = tempListbox2(ILoop) 
				If ILoop <> UBound(tempListBox2) Then 'don't increment on the last pass
					ReDim preserve tempArray(UBound(tempArray) + 1)
				End If
			End If
		Next ILoop
		'MsgBox UBound(MyArray)
		i = UBound(tempArray)
		Erase tempListbox2
	
		ReDim tempListbox2(i)
		For ILoop = 0 To UBound(tempArray)
			'MsgBox "i " & ILoop & " - " & tempArray(ILoop)
			tempListbox2(ILoop) = tempArray(ILoop) 
		Next ILoop

	End If

End Function

Comments

 
sorry , I doubt if I can define in a macro in Excel To open the idea and create the external project in a local folder that I will define this macro ?

Brian Element's picture

You probably could as they both use VBA.  I have successfully used Excel within an IDEA script so you should be able to do the same in Excel.

 
thanks for your attention. I can open excel, but do not know how to reference the Idea.application it in excel follows the code I did:
 
Function cria_plan()  Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select  Selection.Copy Sheets.Add After:=ActiveSheet ActiveSheet.Paste  Dim app As Object  Dim cli As IdeaClient  Dim RetVal RetVal = Shell("C:\Program Files (x86)\CaseWare IDEA\IDEA\idea.exe", 1)  Set app = GetObject '(my question is her)  Set cli = app.Client.ExternalProject = "C:\Users\luizsilva2\Desktop\"  Set cli = app.CreateDatabase(sPath & ".IMD")  Client.ExternalProject = "C:\Users\luizsilva2\Desktop\"  Call importa End Function Function importa()  Set task = Client.GetImportTask("ImportExcel")  dbName = "C:\Users\luizsilva2\Desktop\teste\New Microsoft Excel Worksheet.xlsx"  task.FileToImport = dbName  task.SheetToImport = "Sheet1"  task.OutputFilePrefix = "New Microsoft Excel Worksheet" task.FirstRowIsFieldName = "TRUE"  task.EmptyNumericFieldAsZero = "FALSE"  task.PerformTask  dbName = task.OutputFilePath("Sheet1")  Set task = Nothing  Client.OpenDatabase (dbName) End Function

Brian Element's picture

Hi, I have reformated your code for you.

Function cria_plan()
 Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
 Selection.Copy Sheets.Add After:=ActiveSheet ActiveSheet.Paste
 Dim app As Object
 Dim cli As IdeaClient
 Dim RetVal RetVal = Shell("C:\Program Files (x86)\CaseWare IDEA\IDEA\idea.exe", 1)
 Set app = GetObject '(my question is her)
 Set cli = app.Client.ExternalProject = "C:\Users\luizsilva2\Desktop\"
 Set cli = app.CreateDatabase(sPath & ".IMD")
 Client.ExternalProject = "C:\Users\luizsilva2\Desktop\"
 Call importa End Function Function importa()
 Set task = Client.GetImportTask("ImportExcel")
 dbName = "C:\Users\luizsilva2\Desktop\teste\New Microsoft Excel Worksheet.xlsx"
 task.FileToImport = dbName
 task.SheetToImport = "Sheet1"
 task.OutputFilePrefix = "New Microsoft Excel Worksheet"
 task.FirstRowIsFieldName = "TRUE"
 task.EmptyNumericFieldAsZero = "FALSE"
 task.PerformTask
 dbName = task.OutputFilePath("Sheet1")
 Set task = Nothing
 Client.OpenDatabase (dbName)
End Function

Brian Element's picture

I think the object you are looking for is Idea.IdeaClient but unfortunately your code won't work.  It is not as easy as coping and pasting the IDEAScript code into Excel, there is lots more to it.  I am just wondering what are you trying to do and why are you trying to do it through Excel instead of directly through IDEA?

Brian

 
I realized that is not so simple. But I have to run the macro using Excel why in my work use forms in Excel to open and run a demand routines before importing into the Idea . It is in this Excel macro that identify the number of the call and will save on their network folder , then could create the idea of the project is already in the right folder of the executed demand

Brian Element's picture

Thanks for the info.  Unfortunately I don't have the free time to figure this out right now as it will take some time for me to figure out as I haven't done it before.  You might want to contact your IDEA distributor to see if they can help you out or have suggestions.  What is your time frame for this?

thank you very much for your attention. I will proucurar the responsavei by consulting the Idea . I will continue to follow the tips of your site, that help a lot . congratulations for the work

Brian Element's picture

Thanks, good luck with your project.

Hello, 
First, this snippet is awesome and is very useful. 
I was wondering if you could give a brief explanation as to how to use the "Select Fields" dialog with other project codes. Specifically which pieces of the other functions are necessary for the Select Fields dialog to work correctly. Your code is just way more elegant then what I have put together in the past. 
The other issue is that I don't understand how the ControlID$, Action%, and SuppValue% affect the coding. I also always run into a problem using the DlgListBoxArray. I always seem to get an error when I try to use. 
Any help/advice you can give would be much appreciated. 

Brian Element's picture

Hi Chris,

The code you will need are the four global variables:

Dim tempListbox1() As String 'needed for the variables for the dlgSeletFiles
Dim tempListBox2() As String 'needed for the variables for the dlgSeletFiles
Dim tempListSelect1 As Integer ' var to hold the last SuppValue before hitting the button - need as a global so it is remembered
Dim tempListSelect2 As Integer ' var to hold the last SuppValue before hitting the button - need as a global so it is remembered

You will also need all the code in the Function funSelectFiles(ControlID$, Action%, SuppValue%)

Your results will be stored in the tempListBox2(), not actually that elegent, I should probalby transfer it over to a better named variable.

You will also need the sort array function and the remove blanks function.

The rest of the code will change based on your script.  From my example you can see how I called one dialog from another dialog. 

For your other question I will try and find time to do an explanation in the forum.  Also I have been planning on doing some vidoes on how to create dialogs, this is probably a good time to get my act together and start putting them together.

Good luck on your project.

Brian