ArcCatalogでフォルダ内のフィーチャクラスを効率よく取得する方法

後輩からこんな質問を受けました。

「あるフォルダに47都道府県の子フォルダがあり、その中一つずつジオデータベースがあります。ジオデータベースにはたくさんのフィーチャクラスがあるんですが、これらすべてのフィーチャクラスにすべてメタデータをインポートしたいです。今日はノー残業デーなので早く帰りたいです。」

かわいい後輩のためなら仕方がないと一肌脱ぎました。

フォルダの再帰検索をやればいいんだろうとは思ったんだけど、ぱっと思いつかなかったので楽にコードをかける方法を考えました。

ArcCatalogの検索機能を使うと指定したフォルダ以下を指定したデータ タイプに絞り込んで検索してくれます。検索結果はカタログ ツリーのSearch Results以下にSearchResultsオブジェクトとして取得できるので、これをIEnumObject::Next()で取得する方がコード量的にも簡単でした。コードにはメタデータのインポート方法は割愛して ます。

手順は以下のとおりです。

1. [ArcCatalog] → [編集]メニュー →
   をクリック
2. ダイアログで任意の条件を指定して
   ボタンをクリック
3. 結果がカタログ ツリーの[Search Results] → [マイ サーチ]（デフォルト名）として出力されるので、これを選択
4. 以下のマクロをArcCatalogに貼り付けて実行

Public Sub GetFeatureClassesFromSearchResult()
    Dim pGxApplication As IGxApplication
    Set pGxApplication = Application
    Dim pSearchResults As ISearchResults
    Set pSearchResults = pGxApplication.SelectedObject  '検索結果を選択
    Dim pGxObjectContainer As IGxObjectContainer
    Set pGxObjectContainer = pSearchResults
    Dim pEnumGxObject As IEnumGxObject
    Set pEnumGxObject = pGxObjectContainer.Children
    pEnumGxObject.Reset
    Dim pGxObject As IGxObject
    Set pGxObject = pEnumGxObject.Next
    Do Until pGxObject Is Nothing
        Debug.Print pGxObject.Name
        Set pGxObject = pEnumGxObject.Next
    Loop
    Dim pEnumGxObject As IEnumGxObject
    Dim pMetadata As IMetadata
    Dim pMetadataImport As IMetadataImport
End Sub

後で再帰検索の方法も考えてみました。

'ArcCatalogで選択された任意のフォルダに対しサブフォルダを再帰的に検索して内部のフィーチャクラスを取得
Public Sub GetFeatureClasses()
    Dim pGxApplication As IGxApplication
    Dim pGxObject As IGxObject
    Set pGxApplication = Application
    Set pGxObject = pGxApplication.SelectedObject
    If TypeOf pGxObject Is IGxFolder Then
        Dim pGxObjectContainer As IGxObjectContainer
        Set pGxObjectContainer = pGxObject
        Dim pEnumGxObject As IEnumGxObject
        Set pEnumGxObject = pGxObjectContainer.Children
        GetFeatureClass pEnumGxObject
    Else
        MsgBox "カタログ ツリーでフォルダを選択してください。", vbInformation
    End If
End Sub
'再帰関数
Private Function GetFeatureClass(EnumGxObject As IEnumGxObject)
    EnumGxObject.Reset
    Dim pGxObject As IGxObject
    Set pGxObject = EnumGxObject.Next
    Do Until pGxObject Is Nothing
        If TypeOf pGxObject Is IGxObjectContainer Then
            Dim pGxObjectContainer As IGxObjectContainer
            Set pGxObjectContainer = pGxObject
            If Not pGxObjectContainer.Children Is Nothing Then
                GetFeatureClass pGxObjectContainer.Children '再帰
            End If
        End If
        If TypeOf pGxObject Is IGxDataset Then
            Dim pGxDataset  As IGxDataset
            Set pGxDataset = pGxObject
            If pGxDataset.Type = esriDTFeatureClass Then
                Call RunTheFunction(pGxObject)
            End If
        End If
        Set pGxObject = EnumGxObject.Next
    Loop
End Function
Private Function RunTheFunction(GxDataset As IGxDataset)
    Debug.Print GxDataset.Dataset.Name
End Function

「ありがとうございます。助かりました。」後輩と固く握手を交わし、彼女は定時で帰っていきました。

自分はノー残業できなかったです。

'ArcCatalogで選択された任意のフォルダに対しサブフォルダを再帰的に検索して内部のフィーチャクラスを取得
Public Sub GetFeatureClasses()<br /><br />    Dim pGxApplication As IGxApplication
    Dim pGxObject As IGxObject<br /><br />    Set pGxApplication = Application
    Set pGxObject = pGxApplication.SelectedObject<br /><br />    If TypeOf pGxObject Is IGxFolder Then<br /><br />        Dim pGxObjectContainer As IGxObjectContainer
        Set pGxObjectContainer = pGxObject<br /><br />        Dim pEnumGxObject As IEnumGxObject
        Set pEnumGxObject = pGxObjectContainer.Children<br /><br />        GetFeatureClass pEnumGxObject
    Else
        MsgBox "カタログ ツリーでフォルダを選択してください。", vbInformation
    End If<br /><br />End Sub<br /><br />'再帰関数
Private Function GetFeatureClass(EnumGxObject As IEnumGxObject)<br /><br />    EnumGxObject.Reset<br /><br />    Dim pGxObject As IGxObject
    Set pGxObject = EnumGxObject.Next<br /><br />    Do Until pGxObject Is Nothing<br /><br />        If TypeOf pGxObject Is IGxObjectContainer Then
            Dim pGxObjectContainer As IGxObjectContainer
            Set pGxObjectContainer = pGxObject<br /><br />            If Not pGxObjectContainer.Children Is Nothing Then
                GetFeatureClass pGxObjectContainer.Children '再帰
            End If<br /><br />        End If<br /><br />        If TypeOf pGxObject Is IGxDataset Then
            Dim pGxDataset  As IGxDataset
            Set pGxDataset = pGxObject
            If pGxDataset.Type = esriDTFeatureClass Then
                Call RunTheFunction(pGxObject)
            End If
        End If<br /><br />        Set pGxObject = EnumGxObject.Next<br /><br />    Loop<br /><br />End Function<br /><br />Private Function RunTheFunction(GxDataset As IGxDataset)
    Debug.Print GxDataset.Dataset.Name
End Function