Use VBA to create a table at the selected location

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

1. Start ArcCatalog.
2. 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.

   
   
3. Open Visual Basic Editor.
   
   
   In ArcCatalog, select Tools > Macros > Visual Basic Editor.
   
   
4. In the Project Explorer window, expand the 'Normal (Normal.gxt)' item. Select ArcCatalog Objects > ThisDocument. Right-click and select View Code.
5. 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
   
   
6. 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
   
   
   
7. Click the New button to create a new table.