編集セッション優先でリコンサイル

Attribute VB_Name = "Module"
Option Explicit

'[編集セッション優先]でコンフリクトしたフィーチャをリコンサイル
Sub subReConsile()
    
    Dim pMxDoc As IMxDocument
    Set pMxDoc = ThisDocument
    
    Dim pFLayer As IFeatureLayer
    Set pFLayer = pMxDoc.FocusMap.Layer(0)
    
    Dim pDataset2 As IDataset
    Set pDataset2 = pFLayer.FeatureClass
    
    'ワークスペースの取得
    Dim pVerWorkspace As IVersionedWorkspace
    Set pVerWorkspace = pDataset2.Workspace
    
    Dim pVersionEdit As IVersionEdit3
    Set pVersionEdit = pVerWorkspace
    
    Dim pWorkspaceEdit As IWorkspaceEdit
    Set pWorkspaceEdit = pVersionEdit
    
    pWorkspaceEdit.StartEditing False                   '編集開始(ステートを使用しない)
        
        
    Dim strTargetVersion As String
    strTargetVersion = "SDE.DEFAULT"                    'ターゲット バージョンを指定
    
    Dim Success As Boolean
    Success = pVersionEdit.Reconcile(strTargetVersion)  'リコンサイル実行
    
    Dim pEnumConflictClass As IEnumConflictClass        '競合検知したフィーチャクラスの列挙
    
    Dim pConflictClass As IConflictClass                '競合検知したフィーチャクラス
    Dim pDataset As IDataset
    
    Dim pUUEnumID As IEnumIDs                           'UpdateUpdate時のフィーチャのID群
    Dim pDUEnumID As IEnumIDs                           'DeleteUpdate時のフィーチャのID群
    Dim pUDEnumID As IEnumIDs                           'UpdateDelete時のフィーチャのID群
    
    Dim pSelectionSet As ISelectionSet                  '競合検知したフィーチャ群
    
    Dim pPreTable As ITable                             '編集バージョンの編集開始前のテーブル
    Dim pCurrentTable As ITable                         '編集バージョンのリコンサイル時のテーブル
    
    Set pEnumConflictClass = pVersionEdit.ConflictClasses
    pEnumConflictClass.Reset
    
    Set pConflictClass = pEnumConflictClass.Next
    Do Until pConflictClass Is Nothing
    
        Set pDataset = pConflictClass
        
        '編集バージョンの編集開始前のテーブル(リコンサイル前)
        Dim pPreVersion As IFeatureWorkspace
        Set pPreVersion = pVersionEdit.PreReconcileVersion
        Set pPreTable = pPreVersion.OpenTable(pDataset.Name)
        
        '編集バージョンのリコンサイル時のテーブル(現在)
        Dim pCurrentVersion As IFeatureWorkspace
        Set pCurrentVersion = pVersionEdit
        Set pCurrentTable = pCurrentVersion.OpenTable(pDataset.Name)
        
        'UpdateUpdate(編集バージョン更新,ターゲット バージョン更新)の場合
        Set pSelectionSet = pConflictClass.UpdateUpdates
        Set pUUEnumID = pSelectionSet.IDs
        UpdateResolveConflicts pUUEnumID, pPreTable, pConflictClass     '編集バージョンを優先
                                                                        '※ターゲット バージョンを優先させたい場合は処理しない
        
        'DeleteUpdate(編集バージョン削除,ターゲット バージョン更新)の場合
        Set pSelectionSet = pConflictClass.DeleteUpdates
        Set pDUEnumID = pSelectionSet.IDs

        DeleteResolveConflicts pDUEnumID, pCurrentTable, pConflictClass '編集バージョンを優先
                                                                        '※ターゲット バージョンを優先させたい場合は処理しない
        
        'UpdateDelete(編集バージョン更新,ターゲット バージョン削除)の場合
        Set pSelectionSet = pConflictClass.UpdateDeletes
        Set pUDEnumID = pSelectionSet.IDs
        UpdateResolveConflicts pUDEnumID, pPreTable, pConflictClass     '編集バージョンを優先
                                                                        '※ターゲット バージョンを優先させたい場合は処理しない
        
        Set pConflictClass = pEnumConflictClass.Next
    
    Loop
    
    'ポスト
    If pVersionEdit.CanPost Then
        pVersionEdit.Post (strTargetVersion)
    End If
    
    pWorkspaceEdit.StopEditing True     '編集終了(保存)
    
    
    Set pEnumConflictClass = Nothing
    Set pConflictClass = Nothing
    Set pDataset = Nothing


End Sub

'Update用のコンフリクト解消関数
Private Sub UpdateResolveConflicts(ByRef pEnumID As IEnumIDs, _
                                   ByRef pTable As ITable, _
                                   ByRef pConflictClass As IConflictClass)
    
    pEnumID.Reset
    Dim lngFieldCount As Long
    Dim pID As Long
    pID = pEnumID.Next
    Dim pConflictRow As IFeature
    Dim pPreRow As IRow
    
    Do Until pID = -1
        
        Set pConflictRow = pConflictClass.RestoreRow(pID)
        Set pPreRow = pTable.GetRow(pID)
        
        For lngFieldCount = 0 To pConflictRow.Fields.FieldCount - 1
            '編集可能なフィールドのみ編集します
            If pConflictRow.Fields.Field(lngFieldCount).Editable = True Then
                pConflictRow.Value(lngFieldCount) = pPreRow.Value(lngFieldCount)
            End If
        Next

        pConflictRow.Store
        pID = pEnumID.Next
    Loop
    
End Sub


'Delete用のコンフリクト解消関数
Private Sub DeleteResolveConflicts(ByRef pEnumID As IEnumIDs, _
                                   ByRef pTable As ITable, _
                                   ByRef pConflictClass As IConflictClass)
    
    pEnumID.Reset
    Dim pID As Long
    pID = pEnumID.Next
    Dim pUpdateRow As IRow
    
    Do Until pID = -1
        Set pUpdateRow = pTable.GetRow(pID)
        pUpdateRow.Delete
        pID = pEnumID.Next
    
    Loop
    
End Sub