Append multiple files from same folder
Brian Element
Forums
I had a request from another posting about a script that would append multiple files from the same folder. I had already created one in the past but it lacked any user input, I have changed that with this one. So once you run the script you will have a message saying all the idea files should be stored in the same folder under the project directory. You will then have an input box that will ask you the filename for the new file (don't add the file extension). The script will then read all the IDEA files in that directory and append them together.
Option Explicit
Dim sFolder As String
Dim sFilename As String
Const EXTENSION = "*.IMD"
Dim workingFolder As String
Sub Main
workingFolder =Client.WorkingDirectory()
MsgBox "All the files should be stored in the same folder under the project folder, all IMD files will be appended from that folder"
sFolder = getFolder()
sFilename = InputBox("Please entere the append filename (do not add the extension)", "Enter filename", "")
Call importFiles()
client.refreshFileExplorer
End Sub
Function importFiles()
Dim Files As String
Dim filename As String
Dim dbName As String
Dim db As database
Dim task As task
Files = Dir(sFolder & EXTENSION)
Dim bFirstPassInd As Boolean
bFirstPassInd = true
'MsgBox sFolder & Files
Set db = Client.OpenDatabase(sFolder & Files)
Set task = db.AppendDatabase
Files = Dir
Do
' Get the next file name and place it in FileList.
If Len(Files) > 1 Then
'MsgBox sFolder & Files
task.AddDatabase sFolder & Files
End If
Files = Dir
Loop While Files <> ""
dbName = client.uniquefilename(sFilename)
task.PerformTask dbName, ""
Set task = Nothing
Set db = Nothing
Client.OpenDatabase(dbName)
Set db = Nothing
Set task = Nothing
End Function
'****************************************************************************************************
' Name: getFolder
' Description: Routine to obtain the folder
' Last Update:
' Returns: the folder path
'****************************************************************************************************
Function getFolder() 'this one uses the working directory as the highest level directory
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
Current = Client.WorkingDirectory()
Set oFolder = oShell.BrowseForFolder(0, "Please select the folder where the files are located:", 1, Current)
If (Not oFolder is Nothing) Then
Set oFolderItem = oFolder.Self
oPath = oFolderItem.Path
If Right(oPath, 1) <> "\" Then
oPath = oPath & "\"
End If
End If
getFolder = oPath
End Function