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

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