Import XLS file, add the filename and resave
Forums
Someone at the IDEA site posted a question in which they wanted to import several excel files, add the filename to the file and then resave the excel spreadsheet.
I came up with this script which will hopefully help them up. It first asks for the folder in which the excel files are stored, it then imports all the excel files, in this case each file had a worksheet called school risks, so anyone using this script would have to modify the worksheet name and the new field name.
Option Explicit
Sub Main
Dim db As database
Dim task As task
Dim field As field
Dim folder, xlsFiles, school_name As String
Dim dbName, eqn As String
Dim exportFiles() As String
Dim dbNames() As String
Dim i As Integer
ReDim exportFiles(0)
ReDim dbNames(0)
folder = getFolder()
' Retrieve the first file with a xls file name extension.
xlsFiles = Dir(folder & "*.xls")
' While a call to Dir() continues to return file names.
Do
' Get the next file name and place it in FileList.
If Len(xlsFiles) > 1 Then
school_name = Mid(xlsFiles, 1, InStr(1, xlsFiles, ".") - 1)
Set task = Client.GetImportTask("ImportExcel")
dbName = folder & xlsFiles
task.FileToImport = dbName
task.SheetToImport = "School Risks"
task.OutputFilePrefix = school_name
task.FirstRowIsFieldName = "FALSE"
task.EmptyNumericFieldAsZero = "FALSE"
task.PerformTask
dbName = task.OutputFilePath("School Risks")
Set db = Client.OpenDatabase(dbName)
Set task = db.TableManagement
Set field = db.TableDef.NewField
field.Name = "School Name"
field.Description = ""
field.Type = WI_CHAR_FIELD
field.Equation = """" & school_name & """"
field.Length = 60
task.AppendField field
task.PerformTask
ReDim Preserve exportFiles(UBound(exportFiles) + 1)
ReDim Preserve dbNames(UBound(dbNames) + 1)
exportFiles(UBound(exportFiles)) = folder & school_name & "-updated.XLSX"
dbNames(UBound(dbNames)) = dbName
End If
xlsFiles = Dir
Loop While xlsFiles <> ""
'export the files
For i = 1 To UBound(exportFiles)
Set db = Client.OpenDatabase(dbNames(i))
Set task = db.ExportDatabase
task.IncludeAllFields
eqn = ""
task.PerformTask exportFiles(i), "Database", "XLSX", 1, db.Count, eqn
Next i
Set db = Nothing
Set task = Nothing
Set field = Nothing
Client.RefreshFileExplorer
End Sub
Function getFolder()
Dim BrowseFolder As String
Dim oFolder, oFolderItem
Dim oPath, oShell, strPath
Dim Current As Variant 'per Windows documentation this is defined as a variant and not a string
Set oShell = CreateObject( "Shell.Application" )
Set oFolder = oShell.Namespace(17) 'the 17 indicates that we are looking at the virtual folder that contains everything on the local computer
Set oFolderItem = oFolder.Self
Set strPath = oFolderItem.Path
Set oFolder = oShell.BrowseForFolder(0, "Please select the folder where the files are located:", 1, strPath)
If Not IsNull(oFolder) Then
Set oFolderItem = oFolder.Self
oPath = oFolderItem.Path
If Right(oPath, 1) <> "\" Then
oPath = oPath & "\"
End If
End If
getFolder = oPath
End Function
Hi, Brian. If you haven't
Hi, Brian. If you haven't realize, I can tell this is exactly what I was looking for. Thank you so much!
Update for this comment. It does import all the files but does not create the filename column...I'm thinking that maybe it's because the files name are too long and have hilphens instead of spaces... gonna check.
Hi idemnos,
Hi idemnos,
Did you check out the multiple file import script: http://ideascripting.com/ideascript/import-multiple-files Also I recently created a SmartAnalyzer application that imports multiple files but also allows you to add on filenames: https://ca.marketplace.audicon.net/ca_en/is-multi-file-import-427.html
Both of these items are much more robust then one I posted above and I think I might have used the above as a base for these scripts.
Thanks
Brian
I updated this script and
I updated this script and made it a bit more generic. It will import all xls files from a directory and add the filename to the database.
Option Explicit
Dim folder As String
Dim workingFolder As String
Sub Main
workingFolder =Client.WorkingDirectory()
folder = getFolder()
Call importFiles()
client.refreshFileExplorer
End Sub
Function importFiles()
Dim xlsFiles As String
Dim filename As String
Dim db As database
Dim task As task
Dim field As field
Dim dbName As String
xlsFiles = Dir(folder & "*.xls")
' While a call to Dir() continues to return file names.
Do
' Get the next file name and place it in FileList.
If Len(xlsFiles) > 1 Then
filename = Mid(xlsFiles, 1, InStr(1, xlsFiles, ".") - 1)
Set task = Client.GetImportTask("ImportExcel")
dbName = folder & xlsFiles
task.FileToImport = dbName
task.OutputFilePrefix = filename
task.FirstRowIsFieldName = "TRUE"
task.EmptyNumericFieldAsZero = "FALSE"
task.PerformTask
dbName = getMostRecentFile(workingFolder)
call wait(1)
Set db = Client.OpenDatabase(dbName)
Set task = db.TableManagement
Set field = db.TableDef.NewField
field.Name = "FILENAME"
field.Description = ""
field.Type = WI_CHAR_FIELD
field.Equation = """" & filename & """"
field.Length = 60
task.AppendField field
task.PerformTask
End If
xlsFiles = Dir
Loop While xlsFiles <> ""
Set field = Nothing
Set task = Nothing
Set db = Nothing
End Function
Function GetMostRecentFile(myDir As String)
Dim FileSys As Object
Dim objFile As Object
Dim myFolder
Dim strFilename As String
Dim dteFile As Date
'set up filesys objects
Set FileSys = CreateObject("Scripting.FileSystemObject")
Set myFolder = FileSys.GetFolder(myDir)
'loop through each file and get date last modified. If largest date then store Filename
dteFile = DateSerial(1900, 1, 1)
For Each objFile In myFolder.Files
If objFile.DateLastModified > dteFile Then
dteFile = objFile.DateLastModified
strFilename = objFile.Name
End If
Next objFile
GetMostRecentFile = strFilename
Set FileSys = Nothing
Set myFolder = Nothing
End Function
Function getFolder()
Dim BrowseFolder As String
Dim oFolder, oFolderItem
Dim oPath, oShell, strPath
Dim Current As Variant 'per Windows documentation this is defined as a variant and not a string
Set oShell = CreateObject( "Shell.Application" )
Set oFolder = oShell.Namespace(17) 'the 17 indicates that we are looking at the virtual folder that contains everything on the local computer
Set oFolderItem = oFolder.Self
Set strPath = oFolderItem.Path
Set oFolder = oShell.BrowseForFolder(0, "Please select the folder where the files are located:", 1, strPath)
If Not IsNull(oFolder) Then
Set oFolderItem = oFolder.Self
oPath = oFolderItem.Path
If Right(oPath, 1) <> "\" Then
oPath = oPath & "\"
End If
End If
getFolder = oPath
End Function
Sub Wait(tSecs As Single)
' Timer to create a pause
Dim sngSec As Single
sngSec = Timer + tSecs
Do While Timer < sngSec
Loop
End Sub