Summary
Instructions provided explain how to create a new table, programmatically, using Visual Basic for Applications (VBA) code. This code can be executed with a button-click in ArcCatalog.
If the selected location is a folder, it creates a DBASE (DBF) table.
If the selected location is a geodatabase, it creates a geodatabase table.
Procedure
Follow the steps below:
- Start ArcCatalog.
- Create a new UIButtonControl.
A. Select Tools > Customize to open the Customize dialog box.
B. Select the Commands tab.
C. Select [UIControls] from the Categories list box.
D. Select Untitled from the Save In drop-down list to save the button to this map document. Select Normal to save the button to all ArcMap documents on the machine.
E. Click New UIControl.
F. Select UIButtonControl and click Create.
G. Drag the new UIButtonControl to the toolbar of choice.
H. Close the Customize dialog box.
Note:
If there is already an existing UIButtonControl or the name of the UIButtonControl needs to be changed, make the change to the UIButtonControl code portion below accordingly before the button can be used.
- Open Visual Basic Editor.
In ArcCatalog, select Tools > Macros > Visual Basic Editor.
- In the Project Explorer window, expand the 'Normal (Normal.gxt)' item. Select ArcCatalog Objects > ThisDocument. Right-click and select View Code.
- Paste the following code into the code module.
Private Sub UIButtonControl1_Click()
On Error GoTo Err
Dim pGxApp As IGxApplication
Set pGxApp = Application
Dim pSelObj As IGxObject
Set pSelObj = pGxApp.SelectedObject
Dim location As String
location = pSelObj.FullName 'read the full path to workspace
Dim tableName As String
tableName = InputBox("Please Enter the Name of the New Table:", "New Table", "New_Table")
If tableName = "" Then Exit Sub 'exit if nothing is entered
Dim mypath As String
Dim bTableExist As Boolean
'check for existence of the table name
'concatenate location and table name
If pSelObj.Category = "Personal Geodatabase" Or pSelObj.Category = "Spatial Database Connection" Or pSelObj.Category = "File Geodatabase" Then
bTableExist = CheckGdbTableExists(location, tableName)
mypath = location & "\" & tableName
ElseIf pSelObj.Category = "Folder" Or pSelObj.Category = "Folder Connection" Then
mypath = location & "\" & tableName & ".dbf"
bTableExist = CheckFileExists(mypath)
End If
'create table if table name does not exist
If bTableExist = False Then
'Declare and define index and text Fields
Dim pOIDField As IFieldEdit
Set pOIDField = New Field
pOIDField.Type = esriFieldTypeOID
pOIDField.Name = "OID"
Dim pField As IFieldEdit
Set pField = New Field
pField.Type = esriFieldTypeString
pField.Name = "FIELD1"
pField.Length = 10
'Collect the fields into a fields collection
Dim pFieldsEdit As IFieldsEdit
Set pFieldsEdit = New Fields
pFieldsEdit.AddField pOIDField
pFieldsEdit.AddField pField
'Prepare the required arguments for CreateTable
Dim pFields As IFields
Set pFields = pFieldsEdit
Dim strConfigWord As String
strConfigWord = ""
Dim pFeatureWorkspace As IFeatureWorkspace
'set up the correct workspace factory depending on what was selected
If pSelObj.Category = "Personal Geodatabase" Then
' Instantiate Access Workspace Factory
Dim pAccessFactory As IWorkspaceFactory
Set pAccessFactory = New AccessWorkspaceFactory
Dim pAccessWorkspace As IWorkspace
Set pAccessWorkspace = pAccessFactory.OpenFromFile(pSelObj.FullName, 0)
Set pFeatureWorkspace = pAccessWorkspace
ElseIf pSelObj.Category = "Spatial Database Connection" Then
'exit if it is not a workspace
If Not TypeOf pGxApp.SelectedObject.InternalObjectName.Open Is IWorkspace Then Exit Sub
'read the connection properties: server, service ...
Dim pWksp As IWorkspace
Set pWksp = pGxApp.SelectedObject.InternalObjectName.Open
Dim pPropSet As IPropertySet
Set pPropSet = pWksp.ConnectionProperties
Dim varNames As Variant, varValues As Variant
pPropSet.GetAllProperties varNames, varValues
Dim pSdeFactory As IWorkspaceFactory
Set pSdeFactory = New SdeWorkspaceFactory
Dim pSdeWorkspace As IWorkspace
Set pSdeWorkspace = pSdeFactory.Open(pPropSet, 0) 'open with the connection properties
Set pFeatureWorkspace = pSdeWorkspace
ElseIf pSelObj.Category = "Folder" Or pSelObj.Category = "Folder Connection" Then
Dim pShapefileFactory As IWorkspaceFactory
Set pShapefileFactory = New ShapefileWorkspaceFactory
'Open the folder
Dim pFolderWorkspace As IWorkspace
Set pFolderWorkspace = pShapefileFactory.OpenFromFile(pSelObj.FullName, 0)
Set pFeatureWorkspace = pFolderWorkspace
ElseIf pSelObj.Category = "File Geodatabase" Then
' Instantiate Access Workspace Factory
Dim pFileGDBFactory As IWorkspaceFactory
Set pFileGDBFactory = New FileGDBWorkspaceFactory
Dim pFileGDBWorkspace As IWorkspace
Set pFileGDBWorkspace = pFileGDBFactory.OpenFromFile(pSelObj.FullName, 0)
Set pFeatureWorkspace = pFileGDBWorkspace
'anything else that was selected is not possible to create a table into
Else
MsgBox "A Table Cannot be Created at This Location." & vbNewLine & "Please Select a Geodatabase or Folder Location.", vbInformation, "Cannot Create Table"
Exit Sub
End If
'Create the table
Dim pTable As ITable
Set pTable = pFeatureWorkspace.CreateTable(tableName, pFields, Nothing, Nothing, strConfigWord)
Else
MsgBox "The " & tableName & " Table Already Exists at This Location.", vbExclamation
UIButtonControl1_Click
End If
pGxApp.Refresh location
Exit Sub
Err:
MsgBox Err.Description, vbCritical, "Error Creating Table"
End Sub
- Paste the following code into the code module.
Private Function CheckFileExists(FileName As String) As Boolean
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
CheckFileExists = fso.fileExists(FileName)
End Function
'modified from a posting by Neil Clemmons, esri discussion forum
Private Function CheckGdbTableExists(sWorkspace As String, sTable As String) As Boolean
'this will fail to find an existing sde table because
'the code will not read the username and concatenate
'with the name of the table for sde table names
On Error Resume Next
Dim pAccessFactory As IWorkspaceFactory
Set pAccessFactory = New AccessWorkspaceFactory
Dim pAccessWorkspace As IWorkspace
Set pAccessWorkspace = pAccessFactory.OpenFromFile(sWorkspace, 0)
Dim pFeatureWorkspace As IFeatureWorkspace
Set pFeatureWorkspace = pAccessWorkspace
Dim pTable As ITable
Set pTable = pFeatureWorkspace.OpenTable(sTable)
If pTable Is Nothing Then
CheckGdbTableExists = False
Else
CheckGdbTableExists = True
End If
End Function
- Click the New button to create a new table.