Hello everyone,
I have a script to import multiple files ignoring the file type however it stops in case 5. Can you please clear me why and how can i fix it.
Here the script;
Dim listbox1$()
Dim listbox2$()
Dim mylist$()
Dim templatelist() AS string
Begin Dialog NewDialog 50,40,326,142,"Choose Files:", .superdialog
ListBox 12,10,134,90, listbox1$(), .ListBox1
ListBox 177,12,134,89, listbox2$(), .ListBox2
CancelButton 227,114,40,14, "Cancel", .CancelButton1
OKButton 272,114,40,14, "OK", .OKButton1
PushButton 150,26,19,14, ">", .rightbtn
PushButton 149,50,21,14, "<", .leftbtn
GroupBox 5,5,312,101, .GroupBox1
End Dialog
Begin Dialog BoxExample 15,35,160,72,"Choose File Type:"
OKButton 108,37,40,14
CancelButton 64,37,40,14
DropListBox 14,22,130,10, mylist$(), .DropListBox1
Text 7,5,126,9, "Please choose the file types you wish to import:"
End Dialog
Begin Dialog NewDialog1 50,40,167,63,"Selection", .NewDialog1
OKButton 109,34,40,14, "OK", .OKButton1
CancelButton 62,34,40,14, "Cancel", .CancelButton1
DropListBox 15,18,135,10, templatelist(), .DropListBox1
Text 14,9,76,8, "Please Choose Template File:", .Text1
End Dialog
Public files()
Sub main
On Error GoTo error_handler
Dim extension As String
Dim picked_folder As String
Dim i As Integer
Dim objFSO As Object
Dim objFile As Object
Dim task As Object
Dim field As Object
Dim tableDef As Object
Dim WshShl
Dim fieldrow_bool As Boolean
Dim chosentemplate As String
Dim MyList2$ (9)
MyList2(0) = "dbf"
MyList2(1) = "xls"
MyList2(2) = "mdb"
MyList2(3) = "xml"
MyList2(4)= "asc"
MyList2(5)= "txt"
MyList2(6)= "csv"
MyList2(7)= "dat"
MyList2(8)= "prn"
MyList2(9)= "pdf"
extension = choose_extension()
If extension = -1 Then Exit Sub
picked_folder = browsefolder()
If Not Len(picked_folder) > 0 Then GoTo exit_sub
'Load Array
If (FindFiles(picked_folder & "\", mylist2(extension), files) = True) Then
x = UBound(files)
ReDim listbox1$(x)
ReDim listbox2$(x)
For i = 0 To x
listbox1$(i) = files(i)
Next
Dim mydialog As newdialog
Do
button = Dialog(mydialog)
'------- If button pressed and list isn't empty
If button = 1 And mydialog.listbox1 <> -1 Then
chosenfile = mydialog.listbox1
chosentxt = listbox1$(chosenfile)
z = 0
Do Until listbox2$(z) = ""
z = z + 1
Loop
listbox2$(z) = chosentxt
listbox1$(chosenfile) = ""
End If
If button = 2 And mydialog.listbox2 <> -1Then
chosenfile = mydialog.listbox2
chosentxt = listbox2$(chosenfile)
'------ This part looks for the first empty slot to input the selection
z = 0
Do Until listbox1$(z) = ""
z = z + 1
Loop
'-------- Copies to the first empty slot and clears the selection from the selection list
listbox1$(z) = chosentxt
listbox2$(chosenfile) = ""
End If
cleanup_listbox1
cleanup_listbox2
'------- Loops until Ok or Cancel is clicked
Loop Until button < 1
If button = 0 Then GoTo exit_sub
z = 0
x = UBound(listbox2$)
'---------- Count Values in Listbox2$ array and reinitialize array with new dimensions.
For i = 0 To x
If listbox2$(z) <> "" Then
z = z + 1
End If
Next
ReDim preserve listbox2$(z - 1)
x = UBound(listbox2$)
Select Case extension
Case 0
'------- Run through select statement for each file (i)
For i = 0 To x
' Set-up the dBASE import task
Set task = Client.GetImportTask("DBaseImport")
task.InputFileName (picked_folder & "\" & listbox2$(i))
sample_prefix = Left(listbox2$(i), (Len(listbox2$(i)) - Len( mylist2(extension)) - 1)) ' Removes Extension
task.OutputFileName = Client.UniqueFileName(sample_prefix)
' Execute the task
task.PerformTask
Set task = Nothing
Next
Case 1
fieldrow = MsgBox("Is the first row field names?", 4)
If fieldrow = 6 Then fieldrow_bool = "true" Else fieldrow_bool= "false"
For i = 0 To x
' Set-up the Excel import task
Set task = Client.GetImportTask("ImportExcel" )
task.FirstRowIsFieldName = fieldrow_bool
task.FileToImport = picked_folder & "\" & listbox2$(i)
sample_prefix = Left(listbox2$(i), (Len(listbox2$(i)) - Len( mylist2(extension)) - 1)) ' Removes Extension
task.OutputFilePrefix = sample_prefix
task.EmptyNumericFieldAsZero = FALSE
task.UniqueFilePrefix
'Execute the import
task.PerformTask
Set task = Nothing
Next
Case 2
For i = 0 To x
Set task = Client.GetImportTask("Access")
task.InputFileName = picked_folder & "\" & listbox2$(i)
sample_prefix = Left(listbox2$(i), (Len(listbox2$(i)) - Len( mylist2(extension)) - 1)) ' Removes Extension
task.OutputFileNamePrefix = task.UniqueFileNamePrefix(sample_prefix)
task.DetermineMaximumCharacterFieldLengths = SCAN_ALL
task.AddAllTables
' Execute the Access import task
task.PerformTask
Set task = Nothing
Next
Case 3
For i = 0 To x
' Set-up the XML import task
Set task = Client.GetImportTask("ImportXML")
task.InputFileName = picked_folder & "\" & listbox2$(i)
sample_prefix = Left(listbox2$(i), (Len(listbox2$(i)) - Len( mylist2(extension)) - 1)) ' Removes Extension
task.OutputFileName = task.UniqueBaseFileName(sample_prefix)
' Execute the XML import task
task.PerformTask
Set task = Nothing
Next
Case 5
chosentemplate =choose_template(picked_folder, "rdf")
If Not Len(chosentemplate) > 0 Then
MsgBox "RDF File Not Chosen. Cannot Continue."
GoTo exit_sub
End If
For i = 0 To x
sample_prefix = Left(listbox2$(i), (Len(listbox2$(i)) - Len( mylist2(extension)) - 1)) ' Removes Extension
dbName = client.uniquefilename(sample_prefix)
eqn = ""
Client.ImportDatabase picked_folder & "\" & listbox2$(i), dbName, False, FALSE, eqn, chosentemplate
Next
Case 4, 6
fieldrow = MsgBox("Is the first row field names?", 4)
If fieldrow = 6 Then
fieldrow_bool = 1
Else
fieldrow_bool= 0
End If
chosentemplate =choose_template(picked_folder, "rdf")
If Not Len(chosentemplate) > 0 Then
MsgBox "RDF File Not Chosen. Cannot Continue."
GoTo exit_sub
End If
For i = 0 To x
sample_prefix = Left(listbox2$(i), (Len(listbox2$(i)) - Len( mylist2(extension)) - 1)) ' Removes Extension
dbName = client.UniqueFileName(sample_prefix)
eqn = ""
Client.ImportDelimfile picked_folder & "\" & listbox2$(i), dbName, False, eqn, chosentemplate, fieldrow_bool
Next
Case 7
chosenFdf =choose_template(picked_folder, "fdf")
If Not Len(chosenFdf) > 0 Then
MsgBox "FDF File Not Chosen. Cannot Continue."
GoTo exit_sub
End If
For i = 0 To x
filename = picked_folder & "\" & listbox2$(i)
Set task = Client.GetImportTask("AS400")
task.InputFDFFileName = client.locateinputfile(chosenFdf)
' Set-up the AS400 import task
sample_prefix = Left(listbox2$(i), (Len(listbox2$(i)) - Len( mylist2(extension)) - 1)) ' Removes Extension
dbName = client.UniqueFileName(sample_prefix)
task.OutputFileName = dbName
task.InputDATFilename = client.locateinputfile(filename)
' Execute the AS400 import task
task.PerformTask
Set task = Nothing
Next
Case 8, 9
chosenjpm =choose_template(picked_folder, "jpm")
If Not Len(chosenjpm) > 0 Then
MsgBox "JPM File Not Chosen. Cannot Continue."
GoTo exit_sub
End If
For i = 0 To x
filename = picked_folder & "\" & listbox2$(i)
sample_prefix = Left(listbox2$(i), (Len(listbox2$(i)) - Len( mylist2(extension)) - 1)) ' Removes Extension
dbName = client.UniqueFileName(sample_prefix)
Client.ImportPrintReport chosenjpm, filename, dbName, false
Next
End Select
Else
MsgBox "No Files of " & mylist2(extension) & " type Found"
End If
exit_sub:
Set task = Nothing
Client.RefreshFileExplorer
Exit Sub
error_handler:
MsgBox err.description
GoTo exit_sub
End Sub
Function choose_extension()
' --------- Define an array of items for List Box, Combo Box, and Drop-Down Combo Box
ReDim MyList$ (9)
MyList (0) = "dBase"
MyList (1) = "Excel"
MyList (2) = "Access"
MyList (3) = "XML"
MyList (4) ="ASCII - .ASC"
MyList (5) ="ASCII - .TXT"
MyList (6) ="ASCII - .CSV"
MyList (7) ="AS400"
MyList (8) ="Print Report"
MyList (9) ="Adobe PDF"
'--------- Define and display dialog box
Dim Dlg1 As BoxExample
Button = Dialog (Dlg1)
choose_extension = dlg1.DropListBox1
If Button = -1 Then
choose_extension = dlg1.DropListBox1
Else
choose_extension = -1
End If
End Function
Function BrowseFolder()
Dim oFolder, oFolderItem
Dim oPath, oShell, strPath
Set oShell = CreateObject( "Shell.Application" )
Set oFolder = oShell.Namespace(17)
Set oFolderItem = oFolder.Self
strPath = oFolderItem.Path
msg = "Please select your working directory where"
msg = msg & Chr(10) & "the template and databases are located:"
Set oFolder = oShell.BrowseForFolder(0, msg, 512, strPath)
If oFolder Is Nothing Then
BrowseFolder = ""
Exit Function
End If
Set oFolderItem = oFolder.Self
oPath = oFolderItem.Path
BrowseFolder = oPath
End Function
Private Function FindFiles(path As String, ext As String, files())
Dim ffile As String
ffile = Dir$(path & "*." & ext)
If Len(ffile) = 0 Then Exit Function
'-------- Dir ext = *.ext* fixing by checking length
Do
firstbackspace = strReverse (ffile)
firstbackspacenum = InStr(1,firstbackspace, ".")
importname = Right(ffile, firstbackspacenum - 1)
If Len(importname) = Len(ext) Then
If Not IsNull(ffile) Then
'-------- If one value found return function true and redim array
If (FindFiles = False) Then
ReDim files(0)
FindFiles = True
Else
ReDim Preserve files(UBound(files) + 1)
End If
files(UBound(files)) = ffile
Else
Exit Do
End If
End If
ffile = Dir
Loop Until Len(ffile) = 0
End Function
Private Function choose_template(path As String, ext As String) As String
Dim ffile As String
ffile = Dir$(path & "\*." & ext)
If Len(ffile) = 0 Then
MsgBox " No Template Files Found." & Chr(10) & Chr(13) & Chr(10) & Chr(13) & " Template Files must be in the"& Chr(10) & Chr(13) & "same folder as the source files.",0 , "Need Template"
choose_template = ""
Exit Function
End If
ReDim templatelist(0)
Do Until Len(ffile) = 0
templatelist(UBound(templatelist)) = ffile
ReDim Preserve templatelist(UBound(templatelist) + 1)
ffile = Dir
Loop
Dim dlg3 As NewDialog1
Do
button = Dialog(dlg3)
Loop Until button < 1
If button = 0 Then
choose_template = ""
Exit Function
End If
choose_template = path & "\" & templatelist(dlg3.DropListBox1)
End Function
Sub cleanup_listbox1
x = UBound(listbox1$)
For i = 0 To x
z = i
zzz = listbox1$(z)
If Len(zzz) = 0 Then
Do While Len(zzz) = 0 And z <> x + 1
listbox1$(i) = listbox1$(z)
listbox1$(z) = ""
z = z + 1
zzz = listbox1$(i)
Loop
End If
Next
End Sub
Sub cleanup_listbox2
x = UBound(listbox2$)
For i = 0 To x
z = i
zzz = listbox2$(z)
If Len(zzz) = 0 Then
Do While Len(zzz) = 0 And z <> x + 1
listbox2$(i) = listbox2$(z)
listbox2$(z) = ""
z = z + 1
zzz = listbox2$(i)
Loop
End If
Next
End Sub
Bookmarks