Import XLS file, add the filename and resave

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

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