テーブル結合する方法

'フィーチャレイヤに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