Skip to main content

Running a script on multiple databases before appending

Hi Brian,
I've got two scripts that I'd like to combine to create one process. My goal is be able to categorize each database in a .IDM file (unicode) by appending a field with the first number in each database name before appending all the databases together. Using some other scripts I've found and tweaked, I have the two separate codes I need, but I'm not sure how to put them together.  Any help you could provide would be appreciated.
1. The first code appends the open database with a new field "CHANGE_TYPE". I know I can create a dialog to select multiple databases, but I'm trying to get it so that I can run this on all the databases in a specific file, somehow within the same process as the second code (2.) below:
 
Option Explicit
Dim sFilename As String
 
Sub Main
If getFilename() Then
Call addField()
End If
End Sub
 
Function getFilename()  As Boolean 
On Error Resume Next
sFilename = Client.CurrentDatabase.Name
If sFilename = "" Then
MsgBox "Please open the file to add the filename to."
getFilename = False
Else
getFilename = True
End If
End Function
 
Function addField() 'Append database with new column
Dim db As database
Dim task As task
Dim field As field
Dim sFile As String
sFile = iSplit(sFilename, "", "\", 1, 1) 
Set db = Client.OpenDatabase(sFilename)
Set task = db.TableManagement
Set field = db.TableDef.NewField
field.Name = "CHANGE_TYPE" 'name field type
field.Description = ""
field.Type = WI_CHAR_FIELD
field.Equation = Chr(34) & sFile & Chr(34)
field.Length = Len(1) 'Edit lense size to 1
task.AppendField field
task.PerformTask
Set field = Nothing
Set task = Nothing
Set db = Nothing
 
End Function
 
2. The second code appends all the databases into a new file:
 
Option Explicit
Dim sFolder As String
Dim sFilename As String
Const EXTENSION = "*.IDM"
Dim workingFolder As String
Sub Main 
workingFolder =Client.WorkingDirectory() 
MsgBox "All the files should be stored in the same folder, all IDM files will be appended from that folder"
sFolder = getFolder()
sFilename = InputBox("Please enter 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