Article ID: 158930
Article Last Modified on 10/11/2006
Sub ViewSyncConflict()
Dim Db As DATABASE
Dim Td As TableDef
Dim i as Integer
Set Db = CurrentDb
' Step backward through the TableDefs collection so you
' do not miss any tables when you delete conflict tables.
For i = Db.TableDefs.Count - 1 to 0 Step -1
Set Td = Db.Tabledefs(i)
If (Td.ConflictTable <> "") Then
' Open a recordset based on the conflict table.
' Insert code to do conflict resolution.
' Delete the conflicting record when you are done.
' Delete the conflict table when all its records are deleted.
' Set the ConflictTable property to "".
End If
Next i
End Sub
Sub ViewSyncError()
Dim Db As DATABASE
Dim Rs As Recordset
Dim MsgString As String
On Error GoTo ErrorHandler
Set Db = CurrentDb
Set Rs = Db.OpenRecordset("MSysErrors", dbOpenSnapshot)
Rs.MoveLast
If Rs.RecordCount > 0 Then
Rs.MoveFirst
Do Until Rs.EOF
' Build the error message string.
MsgString = "Table ID: " & Rs!TableGUID & vbCr
MsgString = MsgString & "Record ID: " & Rs!RowGUID & vbCr
MsgString = MsgString & "Operation: " & Rs!Operation & vbCr
MsgString = MsgString & "Failed Because: " & Rs!ReasonText
MsgBox MsgString
Rs.MoveNext
Loop
End If
ExitProc:
Exit Sub
ErrorHandler:
' If the MSysErrors table is empty...
If Err.Number = 3021 Then
Resume ExitProc
' display any other error that occurs.
Else
MsgBox Err.Description
Resume ExitProc
End If
End Sub
Sub ViewDesignError()
Dim Db As DATABASE
Dim Rs As Recordset
Dim MsgString As String
On Error GoTo ErrorHandler
Set Db = CurrentDb
Set Rs = Db.OpenRecordset("MSysSchemaProb", dbOpenSnapshot)
Rs.MoveFirst
Do Until Rs.EOF
' Build the error message string.
MsgString = "Operation: " & Rs!Command & vbCr
MsgString = MsgString & "Failed Because: " & Rs!ErrorText
MsgBox MsgString
Rs.MoveNext
Loop
ExitProc:
Exit Sub
ErrorHandler:
' If the MSysSchemaProb table does not exist.
If Err.Number = 3078 Then
Resume ExitProc
' If the MSysSchemaProb table is empty.
ElseIf Err.Number = 3021 Then
Resume ExitProc
' Display any other error that occurs.
Else
MsgBox Err.Description
Resume ExitProc
End If
End Sub
Function MyCustomFunction()
ViewSyncConflict
ViewSyncError
ViewDesignError
End Function
Sub SetCustomFunction(FunctionName As String)
Dim Db As DATABASE, Ctr As Container, Doc As Document
Dim Prp As Property
On Error GoTo ErrorHandler
Set Db = CurrentDb
Set Ctr = Db.Containers!Databases
' Set Document variable pointing to user defined document.
Set Doc = Ctr.Documents!UserDefined
' Set the ReplicationConflictFunction property if it exists.
Doc.Properties!ReplicationConflictFunction = FunctionName
Exit Sub
ErrorHandler:
' If the property does not exist...
If Err.Number = 3270 Then
' create ReplicationConflictFunction property and set its
' value.
Set Prp = Doc.CreateProperty("ReplicationConflictFunction", _
dbText, FunctionName)
' Append the new property to the collection.
Doc.Properties.Append Prp
' Resume the main procedure.
Resume Next
Else
' Display any other error that occurs.
MsgBox Err.Number & ": " & Err.Description, vbCritical
End If
End Sub
SetCustomFunction("MyCustomFunction()")
Name: ReplicationConflictFunction
Type: Text
Value: MyCustomFunction()
Keywords: kbhowto kbprogramming KB158930