Skip to main content

Import XLS file, add the filename and resave

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

Brian Element Wed, 09/12/2012 - 20:22

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


idemnos Thu, 04/20/2017 - 17:54

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.

idemnos Thu, 04/20/2017 - 19:08

Hi again. I modified the name of the files and the text on every sheet in the xls files before running de ideascript and the exception persists. I copy and paste...It says: the given name for the database is not valid o is in use at this moment.

Brian Element Fri, 04/21/2017 - 11:05

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

The website encountered an unexpected error. Try again later.