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

'******************************************************************************
' 定義      :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
Public Sub Access2StandaloneTable()
    Dim pMxDocument As IMxDocument
    Set pMxDocument = ThisDocument
    
    Dim pStandaloneTableCollection As IStandaloneTableCollection
    Set pStandaloneTableCollection = pMxDocument.FocusMap
    
    Dim pStandaloneTable As IStandaloneTable
    Set pStandaloneTable = pStandaloneTableCollection.StandaloneTable(0)

    Dim pTable As ITable
    Set pTable = pStandaloneTable.Table
End Sub