ソートしたテーブルの作成

'******************************************************************************
' 定義      :Private Function CreateSortedTable()
' 概要      :ソートしたテーブル・フィーチャクラスの取得
' 備考      :元のテーブルをソートしてInMemoryWorkspaceへ出力して返す
' 第1引数   :Table          入力テーブル・フィーチャクラス
' 第2引数   :FieldName      ソート対象フィールド名
' 第3引数   :Ascending      (オプション デフォルト値:True)昇順
' 第4引数   :CaseSensitive  (オプション デフォルト値:False)大文字・小文字の区別
' 戻り値    :ITable         Table・FeatureClass
' 更新履歴  :2010-04-16 作成
'******************************************************************************
Private Function CreateSortedTable(Table As ITable, FieldName As String, Optional Ascending As Boolean = True, Optional CaseSensitive As Boolean = False) As ITable
 
    Dim pTableSort As ITableSort
    Set pTableSort = New TableSort
    pTableSort.Ascending(FieldName) = Ascending
    pTableSort.CaseSensitive(FieldName) = CaseSensitive
    pTableSort.Fields = FieldName
    Set pTableSort.Table = Table
    pTableSort.Sort Nothing
     
    Dim pCursor As ICursor
    Set pCursor = pTableSort.Rows
     
    Dim pFeatureWorkspace As IFeatureWorkspace
    Set pFeatureWorkspace = GetInMemoryWorkspace("temp")
     
    Dim pTable As ITable
     
    If Table Is IFeatureClass Then
        Set pTable = pFeatureWorkspace.CreateFeatureClass("Temp", Table.Fields, Nothing, Nothing, esriFTSimple, "Shape", "")
    Else
        Set pTable = pFeatureWorkspace.CreateTable("Temp", Table.Fields, Nothing, Nothing, "")
    End If
     
    Dim i As Long
     
    Dim pRow As IRow
    Set pRow = pCursor.NextRow
     
    Dim pInsertCursor As ICursor
    Set pInsertCursor = pTable.Insert(True)
     
    Dim pInsertRow As IRow
    Set pInsertRow = pTable.CreateRowBuffer
 
    Do Until pRow Is Nothing
 
        For i = 1 To pTable.Fields.FieldCount - 1
             
            If Not pRow.Fields.Field(i).Name = "Shape_Length" And _
                Not pRow.Fields.Field(i).Name = "Shape_Area" And _
                Not pRow.Fields.Field(i).Name = "OBJECTID" Then
                 
             pInsertRow.Value(i) = pRow.Value(i)
              
            End If
             
        Next i
         
        pInsertCursor.InsertRow pInsertRow
 
        Set pRow = pCursor.NextRow
    Loop
     
    pInsertCursor.Flush
     
    Set SortTable = pTable
 
 
End Function
 
'******************************************************************************
' 定義      :Private Function GetInMemoryWorkspace()
' 概要      :InMemoryWorkspaceの取得
' 備考      :このWorkspaceではCreateFeatureDatasetやCreateQyeryDefは無効
' 第1引数   :String         Workspace名
' 第2引数   :Boolean        (オプション デフォルト値:True)InMemoryWorkspaceを新規作成するかどうか
' 第3引数   :IPropertySet   (オプション デフォルト値:Nothing)DBMSへの接続情報
' 第4引数   :Long           (オプション デフォルト値:0)ウィンドウ ハンドル
' 戻り値    :IWorkspace     Workspace
' 更新履歴  :2008-05-28 作成
'******************************************************************************
Private Function GetInMemoryWorkspace(Name As String, Optional Create As Boolean = True, Optional ConnectionProperties As IPropertySet = Nothing, Optional hWnd As Long = 0) As IWorkspace
    Dim pWorkspaceFactory As IWorkspaceFactory
    Dim pName As IName
    Set pWorkspaceFactory = New InMemoryWorkspaceFactory
     
    If Create = True Then
        Set pName = pWorkspaceFactory.Create("", Name, ConnectionProperties, hWnd)
        Set GetInMemoryWorkspace = pName.Open
    Else
        Set GetInMemoryWorkspace = pWorkspaceFactory.Open(ConnectionProperties, hWnd)
    End If
     
End Function