English

How To: 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

Follow the steps below:

  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.

Related Information