テーブル結合する方法

'フィーチャレイヤにAccessテーブルをテーブル結合
Public Sub JoinTabletoLayer()
    Dim pMxDocument As IMxDocument
    Set pMxDocument = ThisDocument
    
    Dim pFeatureLayer As IFeatureLayer
    Set pFeatureLayer = pMxDocument.FocusMap.Layer(0)  '最上位レイヤを取得
    
'    'レイヤに表示されている属性テーブルの状態を取得する場合(フィルタ設定等を行っている場合)
'    Dim pDisplayTable As IDisplayTable
'    Set pDisplayTable = pFeatureLayer 'QI
    
    Dim pFeatureClass As IFeatureClass
    Set pFeatureClass = pFeatureLayer.FeatureClass
'    Set pFeatureClass = pDisplayTable.DisplayTable
    
    'Accessからテーブルを取得
    Dim pWorkspaceFactory As IWorkspaceFactory
    Set pWorkspaceFactory = New AccessWorkspaceFactory
    
    Dim pFeatureWorkspace As IFeatureWorkspace
    Set pFeatureWorkspace = pWorkspaceFactory.OpenFromFile("D:\Workspace\db1.mdb", 0)
    
    Dim pTable As ITable
    Set pTable = pFeatureWorkspace.OpenTable("Table1")  'Accessのテーブル名
    
    'メモリ上にリレーションシップを作成
    Dim pMemoryRelationshipClassFactory As IMemoryRelationshipClassFactory
    Set pMemoryRelationshipClassFactory = New MemoryRelationshipClassFactory
    
    '結合キーフィールド名
    Dim strOriginPrimaryKeyField As String
    Dim strOriginForeignKeyField As String
    strOriginPrimaryKeyField = "Field2"
    strOriginForeignKeyField = "FLAG1"
    
    Dim pRelationshipClass As IRelationshipClass
    Set pRelationshipClass = pMemoryRelationshipClassFactory.Open( _
        "TabletoLayer", _
        pTable, _
        strOriginPrimaryKeyField, _
        pFeatureClass, _
        strOriginForeignKeyField, _
        "forward", _
        "backward", _
        esriRelCardinalityOneToMany)
        
        'IMemoryRelationshipClassFactory::Openの引数
        '第1引数:テーブル結合の名称(GUIでは特に使用しません)
        '第2引数:結合先のテーブル
        '第3引数:結合先テーブルの結合キー(フィールド名)
        '第4引数:結合元のテーブル(フィーチャクラス)
        '第5引数:結合元テーブルの結合キー(フィールド名)
        '第6引数:ForwardPathLabel(この文字列で設定)
        '第7引数:BackwardPathLabel(この文字列で設定)
        '第8引数:リレーションシップ方法(1対1,1体多,多対多)テーブル結合の場合は上記設定とする
    
    'テーブル結合を実行
    Dim pDisplayRelationshipClass As IDisplayRelationshipClass
    Set pDisplayRelationshipClass = pFeatureLayer
    pDisplayRelationshipClass.DisplayRelationshipClass pRelationshipClass, _
        esriLeftOuterJoin 'テーブル結合の高度な設定(すべてのレコードを保存)
  
End Sub


'Developer Helpサンプル
'http://edndoc.esri.com/arcobjects/9.2/CPP_VB6_VBA_VCPP_Doc/COM_Samples_Docs/Tables/6691d042-b2e5-4e15-bc6c-99c8ea9289ce.htm




Public Sub JoinTwoLayers()

On Error GoTo EH

Dim pDoc As IMxDocument
Dim pMap As IMap
Set pDoc = ThisDocument
Set pMap = pDoc.FocusMap

' Get the first layer in the table on contents
Dim pFeatLayer As IFeatureLayer
Dim pDispTable As IDisplayTable
Dim pFCLayer As IFeatureClass
Dim pTLayer As ITable
If pMap.LayerCount = 0 Then
MsgBox "Must have at least one layer"
Exit Sub
End If
Set pFeatLayer = pMap.Layer(0)
Set pDispTable = pFeatLayer
Set pFCLayer = pDispTable.DisplayTable
Set pTLayer = pFCLayer

' Get the second layer in the table on contents
Dim pFeat2Layer As IFeatureLayer
Dim pDispTable2 As IDisplayTable
Dim pFC2Layer As IFeatureClass
Dim pT2Layer As ITable
Set pFeat2Layer = pMap.Layer(1)
Set pDispTable2 = pFeat2Layer
Set pFC2Layer = pDispTable2.DisplayTable
Set pT2Layer = pFC2Layer
Dim pTTable As ITable
Set pTTable = pDispTable2.DisplayTable

' Prompt for the join field, in this example both joined
' fields must be named the same.
Dim strJnField As String
strJnField = InputBox("Provide the name of the join field:", "Joining a table to a layer", _
"STATE_FIPS")

' Create virtual relate
Dim pMemRelFact As IMemoryRelationshipClassFactory
Dim pRelClass As IRelationshipClass
Set pMemRelFact = New MemoryRelationshipClassFactory
Set pRelClass = pMemRelFact.Open("TabletoLayer", pTTable, strJnField, pTLayer, _
strJnField, "forward", "backward", esriRelCardinalityOneToOne)

' use Relate to perform a join
Dim pDispRC As IDisplayRelationshipClass
Set pDispRC = pFeatLayer
pDispRC.DisplayRelationshipClass pRelClass, esriLeftOuterJoin

'code to mimic the C code snippet
Dim pRelQueryTableFactory As IRelQueryTableFactory
Set pRelQueryTableFactory = New RelQueryTableFactory
Dim pRelQueryTable As ITable
Set pRelQueryTable = pRelQueryTableFactory.Open(pRelClass, True, Nothing, Nothing, "", True, False)

Dim pBdyPointFC As IFeatureClass
'Set pBdyPointFC = pRelClass
Set pBdyPointFC = pRelQueryTable

Dim pFeatureLayer As IFeatureLayer
Set pFeatureLayer = New FeatureLayer
Set pFeatureLayer.FeatureClass = pBdyPointFC
pFeatureLayer.Name = "Joined Layer"

 pMap.AddLayer pFeatureLayer
 pDoc.ActiveView.Refresh

Exit Sub
EH:

MsgBox Err.Number & " " & Err.Description

End Sub