FAQ
VBA を使用して指定の場所にテーブルを新規作成する方法

ナレッジ番号:5526 | 登録日:2023/07/27 | 更新日:2024/11/21

【概要】
VBA プログラミングにより、テーブルを新規作成する方法について解説します。このコードは ArcCatalog でのボタン クリックにより実行されます。

選択された場所がフォルダの場合、DBASE(DBF)テーブル、ジオデータベースの場合はジオデータベース テーブルを作成します。

【手順】
下記のステップで行います。

  1. ArcCatalog を起動します。

  2. UIButtonControl を新規作成します。

    A. [ツール] > [カスタマイズ] からカスタマイズ ダイアログ ボックスを開きます。
    B. [コマンド] タブを選択します。
    C. [カテゴリ] リストボックスから [UIControls] を選択します。
    D. [保存先] ドロップダウン リストで ’Normal.gxt’ が選択されていることを確認します。
    E. [新規 UIControl] をクリックします。
    F. UIButtonControl を選択し、[作成] をクリックします。
    G. 新規 UIButtonControl を任意のツールバーにドラッグします。
    H. [カスタマイズ] ダイアログを閉じます。

    ※既存の UIButtonControl が存在する場合、または UIButtonControl の名前を変更したい場合は、
    ボタンが使用される前に UIButtonControl のコード部分についても適宜変更しなければなりません。

  3. Visual Basic Editor を開きます(ArcCatalog の [ツール] > [マクロ] > [Visual Basic Editor])。

  4. プロジェクト エクスプローラ ウィンドウで、'Normal (Normal.gxt)' を展開し、ArcCatalog Objects > ThisDocument を選択します。右クリックして、[コードの表示] を選択します。

  5. 以下のコードをコード モジュールにコピー&ペーストします。

    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 'ワークスペースのフルパスを読み込みます。
    Debug.Print location

    Dim tableName As String
    tableName = InputBox("新規テーブルの名前を入力してください。", "新規テーブルの作成", "New_Table")

    If tableName = "" Then Exit Sub '何も入力されない場合は、IF 構文を抜けます。

        Dim mypath As String
        Dim bTableExist As Boolean
       
        'テーブル名の存在の有無をチェックし、場所とテーブル名を連結します。
        If pSelObj.Category = "パーソナル ジオデータベース" Or _
           pSelObj.Category = "空間データベース コネクション" Or _
           pSelObj.Category = "ファイル ジオデータベース" Then
           
           bTableExist = CheckGdbTableExists(location, tableName)

        ElseIf pSelObj.Category = "フォルダ" _
            Or pSelObj.Category = "フォルダ接続" Then
           
            mypath = location & "\" & tableName & ".dbf"
            bTableExist = CheckFileExists(mypath)
       
        End If
       
        'テーブル名が存在しない場合、テーブルを作成します。
       
        If bTableExist = False Then
       
            'インデックスとテキスト フィールドを定義します。
           
            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
           
            '各フィールドをフィールド コレクションに追加します。
           
            Dim pFieldsEdit As IFieldsEdit
            Set pFieldsEdit = New fields
            pFieldsEdit.AddField pOIDField
            pFieldsEdit.AddField pField
           
            'CreateTable に必要な引数を準備します。
           
            Dim pFields As IFields
            Set pFields = pFieldsEdit
           
            Dim strConfigWord As String
            strConfigWord = ""
           
            Dim pFeatureWorkspace As IFeatureWorkspace
       
        '選択された場所に応じて正しいワークスペースを設定します。
       
            If pSelObj.Category = "パーソナル ジオデータベース" Then
       
            'パーソナル ジオデータベースを作成するために必要なワークスペース ファクトリ(AccessWorkspaceFactory)のインスタンスを作成します。
           
                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 = "空間データベース コネクション" Then
           
            'ワークスペースでない場合、IF 構文を抜けます。
           
                If Not TypeOf pGxApp.SelectedObject.InternalObjectName.Open Is IWorkspace Then
                  Exit Sub
                End If
           
            '接続プロパティを読み込みます(サーバ、サービス ...)。
           
                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)   '接続プロパティを使用して開きます。
               
                Set pFeatureWorkspace = pSdeWorkspace
               
            ElseIf pSelObj.Category = "フォルダ" Or pSelObj.Category = "フォルダ接続" Then
               
                Dim pShapefileFactory As IWorkspaceFactory
                Set pShapefileFactory = New ShapefileWorkspaceFactory
               
                'フォルダを開きます。
               
                Dim pFolderWorkspace As IWorkspace
                Set pFolderWorkspace = pShapefileFactory.OpenFromFile(pSelObj.FullName, 0)
               
                Set pFeatureWorkspace = pFolderWorkspace
               
            ElseIf pSelObj.Category = "ファイル ジオデータベース" Then
               
                'ファイル ジオデータベース ワークスペース ファクトリのインスタンスを作成します。
               
                Dim pFileGDBFactory As IWorkspaceFactory
                Set pFileGDBFactory = New FileGDBWorkspaceFactory
               
                Dim pFileGDBWorkspace As IWorkspace
                Set pFileGDBWorkspace = pFileGDBFactory.OpenFromFile(pSelObj.FullName, 0)
               
                Set pFeatureWorkspace = pFileGDBWorkspace
               
            'その他のワークスペースではテーブルを作成することはできません。
            Else
               
                    MsgBox "この場所にテーブルを作成することはできません。" & vbNewLine & "ジオデータベースまたはフォルダを選択してください。", vbInformation, "Cannot Create Table"
               
            Exit Sub
            End If
         
            'テーブルを作成します。
        Dim pTable As ITable
        Set pTable = pFeatureWorkspace.CreateTable(tableName, pFields, Nothing, Nothing, strConfigWord)
           
        Else
           
        MsgBox tableName & "テーブルは、既にこの場所に存在します。", vbExclamation
            UIButtonControl1_Click
        End If
       
    pGxApp.Refresh location

    Exit Sub

    Err:

    MsgBox Err.Description, vbCritical, "テーブル作成中にエラーが生じました。"

    End Sub


  6. 以下のコードをコード モジュールにコピー&ペーストします。

    Private Function CheckFileExists(FileName As String) As Boolean

    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")
    CheckFileExists = fso.fileExists(FileName)
    End Function


    '下記は、Neil Clemmons 氏によって ESRI Discussion Forum に提供されたコードを編集したものです。

    Private Function CheckGdbTableExists(sWorkspace As String, sTable As String) As Boolean

    'このコードはユーザ名を読み込まず、テーブル名とSDEテーブル名を連結しないため、
    'SDE テーブルの検索は失敗します。

        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. 新規ボタンをクリックし、テーブルを新規作成します。
■関連情報

メタデータ

機能

種類

製品