FAQ
VBA を使用して指定の場所にテーブルを新規作成する方法
ナレッジ番号:5526 | 登録日:2023/07/27 | 更新日:2024/11/21
- 【概要】
VBA プログラミングにより、テーブルを新規作成する方法について解説します。このコードは ArcCatalog でのボタン クリックにより実行されます。
選択された場所がフォルダの場合、DBASE(DBF)テーブル、ジオデータベースの場合はジオデータベース テーブルを作成します。
【手順】
下記のステップで行います。
- ArcCatalog を起動します。
- UIButtonControl を新規作成します。
A. [ツール] > [カスタマイズ] からカスタマイズ ダイアログ ボックスを開きます。
B. [コマンド] タブを選択します。
C. [カテゴリ] リストボックスから [UIControls] を選択します。
D. [保存先] ドロップダウン リストで ’Normal.gxt’ が選択されていることを確認します。
E. [新規 UIControl] をクリックします。
F. UIButtonControl を選択し、[作成] をクリックします。
G. 新規 UIButtonControl を任意のツールバーにドラッグします。
H. [カスタマイズ] ダイアログを閉じます。
※既存の UIButtonControl が存在する場合、または UIButtonControl の名前を変更したい場合は、
ボタンが使用される前に UIButtonControl のコード部分についても適宜変更しなければなりません。
- Visual Basic Editor を開きます(ArcCatalog の [ツール] > [マクロ] > [Visual Basic Editor])。
- プロジェクト エクスプローラ ウィンドウで、'Normal (Normal.gxt)' を展開し、ArcCatalog Objects > ThisDocument を選択します。右クリックして、[コードの表示] を選択します。
- 以下のコードをコード モジュールにコピー&ペーストします。
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
- 以下のコードをコード モジュールにコピー&ペーストします。
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
- 新規ボタンをクリックし、テーブルを新規作成します。
- ArcCatalog を起動します。
メタデータ
機能
種類
製品