Friday, December 15, 2006

Calendar Conflicts in Cached Exchange Mode in 2K3 sp2

Administrators universally agree that cached exchange mode in Exchange 2003 is a good thing providing added value and reliability to their infrastructure.

Programmers who write applications which interact with the calendaring functions unfortunately, are tearing their hair out and cursing their fates.


The situation:

We've built Rhino, an Exchange (server-side) solution to intercept and process calendar messages. The solution uses a synchronous an Exchange event sink. The event sink understands certain rules (via an XML file) that allow the system admin to :

  • Process meeting requests, replies, or both;
  • Skip managed resources;
  • Process requests as tentative, accept, or decline, and show the meeting as free, busy, or out of office
  • Process replies - keep/delete accepts/declines/tentatives or any reply with a reply from the end user.
  • All replies are processed to update the owner's tracking tab.

We manage the messages at the server side using CDOEX (version 6.5.7638.1) and EXOLEDB (version 6.5.7650.7) embedded within a synchronous event sink. This event sink works as designed when clients are connected to the Exchange server without Cached Mode.

The problem:

The problems that we are seeing is that the sink generates an Outlook Sync Issues "Conflicts" when clients use outlook in 'cached exchange mode'. i.e. clients see message on the meeting ... "You made changes to another copy of this item. This is the most recent version...."
Also when an Outlook meeting owner attempts to update one occurrence of the meeting, and changes the location, or adds an agenda, the meeting owner's calendar doesn't always get updated with the changes that he/she just made (e. g., the agenda gets lost, the location disappears from the subject line annotation in the calendar view, but still exists in the meeting detail view); and agendas are never received by the end user, until the meeting owner updates the same meeting occurrence twice.

Clients most frequently see this conflict message when they update meetings, or change a single occurrence of a recurring meeting.

What is going on here:

This is a bug in the ICS (Incremental Change System) for Exchange 2003 in cached mode.

Steps to reproduce:

  1. Create a Synchronous event sink in VB 6 using the event sink wizard from the exchange SDK.
  2. Add in code to detect and process calendar messages (see MSDN: http://msdn.microsoft.com/library/default.asp?url=/library/en-us/e2k3/e2k3/_cdo_processing_meeting_request_responses.asp
  3. Compile the code, register the event sink on your system mailboxes
  4. Create a recurring meeting using Outlook in Cached Exchange mode.
  5. Have that “guest” accept the meeting
  6. Open an occurrence of the meeting, and change the location, agenda, etc. Send an update, then switch to the inbox.
  7. Have the “guest” accept the update.
  8. Open the Guest’s response message (in your inbox)
  9. Switch to the calendar and open the meeting (you should see a conflict)

We've added the VB source code for main module as a comment to this post. The VB Project is available to those who request it.

Remedies we have tried already:

Microsoft support suggested their Auto Accept Agent that is implemented as an asynchronous event sink, but again you need to install this on every mailbox:
883130 The Auto Accept Agent Deployment and Administration Guide is now available
http://support.microsoft.com/default.aspx?scid=kb;EN-US;883130
903290 You should not register a resource mailbox for Auto Accept Agent in Exchange 2003 when you set up a resource for direct booking in Outlook
http://support.microsoft.com/default.aspx?scid=kb;EN-US;903290

Note: The auto accept agent is also an async OnSave agent.

Non-viable options:

  • Don't use cached mode with Outlook 2003 (This isn't an acceptable solution)
  • Asynchronous sinks (We tries these and it still generates conflicts, aside from which they need to be registered on each mailbox)
  • Direct booking (Really geared towards resource mailboxes)
  • Server-side rules could be set up to try to handle this (Again this would have to be implemented on every mailbox where we want this functionality -- more complex administration overhead)

Our solution:

We're implementing an Outlook best-practices client-side COM+ add-in for Outlook 2003 / 2007. Please feel free to contact us if you want to try it out.

at

1 comment:

  1. zygDecember 15, 2006 at 11:05 AM

    Attribute VB_Name = "msModule"

    Public Const LogFile As String = "StoreSink.log" 'Name of the file where a log of all the activities in this sink will be stored.
    Public Const PERFORM_FILE_LOGGING As Boolean = True 'Set this constant to False to prevent any event logging from occurring
    Public Const PERFORM_ERROR_LOGGING As Boolean = True 'Set this constant to False to prevent any error logging from occurring
    Public Const DATE_TIME_FORMAT As String = "dddd, mmmm dd, yyyy, hh:nn:ss AM/PM" 'Set the format of the date-time that will get written
    '
    Function ProcessBeginSave(ByVal pEventInfo As Exoledb.IExStoreEventInfo, ByVal bstrURLItem As String, ByVal lFlags As Long) As Boolean

    'This function is called when the Item is being saved and the OnSyncSave
    'event is fired for the first time in this event sink. Returns True if
    'successful, False if not.

    Dim pDispEventInfo As Exoledb.IExStoreDispEventInfo 'Declare a pointer to the interface that returns information about the executing store event.
    Dim recItem As ADODB.Record 'Record Object that will point to the item that triggered this event.
    '============================================================================================
    'ADDED BY SUMATRA
    ProcessBeginSave = True
    Exit Function

    On Error GoTo Errorhandler

    'Assume that the function is successful. If any checks which may be coded below fail,
    ' or if an error occurs, then return False, which would cause the transaction to be aborted.
    ProcessBeginSave = True

    'Write to the log file that this function has been called.
    Call EventLog("OnSyncSave", bstrURLItem, lFlags, "Begin Phase")

    Set pDispEventInfo = pEventInfo 'Assign the passed IExStoreEventInfo object reference
    Set recItem = pDispEventInfo.EventRecord 'get the Record object bound to the item that triggered the event

    'Evaluate the different scenarios in which the Save might have been triggered.
    If lFlags And EVT_NEW_ITEM Then
    'The item being saved is a new item.
    'Some role checking can be done - like below
    'If GetSecurityCallContext.IsSecurityEnabled Then
    'If Not GetSecurityCallContext.IsCallerInRole("Example Role") Then
    ''User is not in a defined role. Handle the condition here
    ''like preventing the delete by aborting the transaction; i.e.
    'pDispEventInfo.AbortChange
    'End If
    'End If
    'The item can be processed below.
    With recItem
    'Process the item's properties, set default values, validate fields etc. here
    End With
    End If
    'The following blocks of code are similar to the previous one. Similar code can be applied
    'here as shown above, like role checking etc.
    If lFlags And EVT_REPLICATED_ITEM Then
    'The item is being saved as a result of replication
    End If
    If lFlags And EVT_IS_DELIVERED Then
    'The item is being saved as the result of message delivery
    End If
    If lFlags And EVT_INVALID_URL Then
    'The URL passed to the sink is invalid.
    End If
    If lFlags And EVT_IS_COLLECTION Then
    'The item being saved is a collection.
    End If
    If lFlags And EVT_ERROR Then
    ' An error occurred in the event.
    End If

    Exit Function
    Errorhandler:
    'Some error has occurred. The function can return False (as in the next line) so that the save can be aborted.
    'ProcessBeginSave = False
    'Log any errors that occur in this function.
    Call ErrorLog("ProcessBeginSave", CStr(Err.Number) & vbTab & Err.Description, bstrURLItem, lFlags)
    End Function


    Sub ProcessCommitSave(ByVal pEventInfo As Exoledb.IExStoreEventInfo, ByVal bstrURLItem As String, ByVal lFlags As Long)

    'This function is called after the save of the Item has been committed.
    'NOTE: The item is now read-only. Changes made to the item here will not be reflected in the store.

    Dim pDispEventInfo As Exoledb.IExStoreDispEventInfo 'Declare a pointer to the interface that returns information about the executing store event.
    Dim recItem As ADODB.Record 'Record Object that will point to the item that triggered this event.
    '============================================================================================
    ' Added by Sumatra
    '


    Dim iCalMsg As CDO.CalendarMessage
    Dim iMbx As IMailbox
    Dim person As New CDO.person
    Dim msg_to As String
    Dim strURL As String


    On Error GoTo Err_ProcessCommitSave


    Call EventLog("ProcessCommitSave", bstrURLItem, lFlags, "Startup-Sumatra")

    If LenB(bstrURLItem) = 0 Then
    Call EventLog("ProcessCommitSave", bstrURLItem, lFlags, "Empty URL")

    End If

    Set pDispEventInfo = pEventInfo
    Set recItem = pDispEventInfo.EventRecord 'get the Record object bound to the item that triggered the event

    Call EventLog("ProcessCommitSave", bstrURLItem, lFlags, "Got event record")


    'Evaluate the different scenarios in which the Save might have been triggered.
    If lFlags And EVT_NEW_ITEM Then
    'The item being saved is a new item.
    End If

    If lFlags And EVT_REPLICATED_ITEM Then
    'The item is being saved as a result of replication
    End If

    If lFlags And EVT_IS_DELIVERED Then
    'The item is being saved as the result of message delivery

    Call EventLog("ProcessCommitSave", bstrURLItem, lFlags, "EVT_IS_DELIVERED-Sumatra")


    'check if a calendar message
    'contentclass"" = 'urn:content-classes:calendarmessage'"
    If recItem.Fields("DAV:contentclass") = "urn:content-classes:calendarmessage" Then

    Call EventLog("ProcessCommitSave", bstrURLItem, lFlags, "IS Calendar message")

    'Parse fields to determine who the person is
    msg_to = Split(bstrURLItem, "/")(6) & "@" & Split(bstrURLItem, "/")(4)
    strURL = "mailto:" & msg_to
    Call EventLog("ProcessCommitSave", bstrURLItem, lFlags, "Open Person:" & strURL & "-Sumatra")
    Set person = New CDO.person 'COULD ALSO CreateObject("CDO.Person")
    person.DataSource.Open strURL

    ' Now get the mailbox
    Set iMbx = person.GetInterface("IMailbox")

    ' Open the calendar message
    Call EventLog("OnSyncSave", bstrURLItem, lFlags, "Open Calendar Message-Sumatra")
    Set iCalMsg = New CalendarMessage
    iCalMsg.DataSource.Open bstrURLItem, , adModeReadWrite


    Call ProcessResponse(iCalMsg, iMbx)

    Else
    Call EventLog("ProcessCommitSave", bstrURLItem, lFlags, "NOT Calendar message; contentclass: " & recItem.Fields("contentclass").Value)

    End If 'test if calendar message

    End If

    If lFlags And EVT_INVALID_URL Then
    'The URL passed to the sink is invalid.
    End If

    If lFlags And EVT_IS_COLLECTION Then
    'The item being saved is a collection.
    End If

    If lFlags And EVT_ERROR Then
    ' An error occurred in the event.
    End If


    Exit_ProcessCommitSave:
    'release objects
    Set person = Nothing
    Set iMbx = Nothing
    Set iCalMsg = Nothing
    Set recItem = Nothing
    Set pDispEventInfo = Nothing
    Exit Sub

    Err_ProcessCommitSave:
    'Log any errors that occur in this subroutine
    Call ErrorLog("ProcessCommitSave", CStr(Err.Number) & vbTab & Err.Description, bstrURLItem, lFlags)
    Err.Clear
    Resume Exit_ProcessCommitSave

    End Sub



    '============================================================================================
    'ADDED BY SUMATRA FROM
    'SOURCE:
    'http://msdn.microsoft.com/library/default.asp?url=/library/en-us/e2k3/e2k3/_cdo_processing_meeting_request_responses.asp

    Sub ProcessResponse(iCalMsg As CDO.CalendarMessage, iMbx As IMailbox)
    ' Reference to Microsoft ActiveX Data Objects 2.5 Library
    ' Reference to Microsoft CDO for Exchange 2000 Library

    ' Note: It is recommended that all input parameters be validated when they are
    ' first obtained from the user or user interface.
    Dim Rec As New ADODB.Record
    Dim Conn As New ADODB.Connection

    '============================================================================================
    'MODIFIED BY SUMATRA
    ' below is commented out.....causes compiler error
    ' Dim iCalMsg As New CalendarMessage
    Dim iCalPart As ICalendarPart
    Dim iAppt As CDO.Appointment
    On Error GoTo Err_ProcessResponse

    Call EventLog("ProcessResponse", bstrURLItem, lFlags, "Started; Subj=" & iCalMsg.Message.Subject & " -Sumatra")

    App.LogEvent "iCalMsg GUID: " & iCalMsg.Message.Fields("http://schemas.microsoft.com/exchange/permanenturl").Value

    Conn.Provider = "ExOLEDB.DataSource"
    Conn.Open iMbx.BaseFolder

    For Each iCalPart In iCalMsg.CalendarParts
    Set iAppt = iCalPart.GetUpdatedItem(iMbx.Calendar)

    App.LogEvent "Appt in CalPart GUID: " & iAppt.Fields("http://schemas.microsoft.com/exchange/permanenturl").Value


    Call EventLog("ProcessResponse", bstrURLItem, lFlags, "Got Appt from Calpart; Subj=" & iCalMsg.Message.Subject & " -Sumatra")

    Select Case iCalPart.CalendarMethod

    Case "REQUEST"
    Call EventLog("ProcessResponse", bstrURLItem, lFlags, "Request; subj=" & iCalMsg.Message.Subject & "-Sumatra")

    Case "REPLY" ' Make sure this is a reply
    App.LogEvent "MSTEST2 Item URL: " & iAppt.Subject
    App.LogEvent "MSTEST2 Fired at (Before the save): " & Now

    iAppt.DataSource.Save

    App.LogEvent "MSTEST2 Fired at (After the save): " & Now

    Call EventLog("ProcessResponse", bstrURLItem, lFlags, "YEA!! Reply Saved-CalUpdated; subj=" & iCalMsg.Message.Subject & "-Sumatra")

    Case "CANCEL"
    Call EventLog("ProcessResponse", bstrURLItem, lFlags, "Cancellation; subj=" & iCalMsg.Message.Subject & "-Sumatra")

    Case Else
    Call EventLog("ProcessResponse", bstrURLItem, lFlags, "Not a REPLY: " & iCalPart.CalendarMethod & "; subj=" & iCalMsg.Message.Subject & "-Sumatra")

    End Select
    Next

    Exit_ProcessResponse:
    ' Clean up.
    Conn.Close
    Set Conn = Nothing
    Set Rec = Nothing
    Set iAppt = Nothing
    Set iCalPart = Nothing

    Exit Sub


    Err_ProcessResponse:
    'Log any errors that occur in this subroutine
    Call ErrorLog("ProcessResponse-ERROR", CStr(Err.Number) & vbTab & Err.Description, bstrURLItem, lFlags)
    Err.Clear
    Resume Exit_ProcessResponse


    End Sub
    '============================================================================================


    Sub ProcessAbortSave(ByVal pEventInfo As Exoledb.IExStoreEventInfo, ByVal bstrURLItem As String, ByVal lFlags As Long)

    'This subroutine is called when saving the item is aborted. The Save is being cancelled here.
    'NOTE: The item does not get into the Exchange Store here.

    Dim pDispEventInfo As Exoledb.IExStoreDispEventInfo 'Declare a pointer to the interface that returns information about the executing store event.
    Dim recItem As ADODB.Record 'Record Object that will point to the item that triggered this event.
    '============================================================================================
    'ADDED BY SUMATRA
    Exit Sub

    On Error GoTo Errorhandler

    'Write to the log file that this subroutine has been called.
    Call EventLog("OnSyncSave", bstrURLItem, lFlags, "Abort Phase")

    Set pDispEventInfo = pEventInfo 'Assign the passed IExStoreEventInfo object reference
    Set recItem = pDispEventInfo.EventRecord 'get the Record object bound to the item that triggered the event

    'Evaluate the different scenarios in which the Save might have been triggered.
    If lFlags And EVT_NEW_ITEM Then
    'The item being saved is a new item.
    End If
    If lFlags And EVT_REPLICATED_ITEM Then
    'The item is being saved as a result of replication
    End If
    If lFlags And EVT_IS_DELIVERED Then
    'The item is being saved as the result of message delivery
    End If
    If lFlags And EVT_INVALID_URL Then
    'The URL passed to the sink is invalid.
    End If
    If lFlags And EVT_IS_COLLECTION Then
    'The item being saved is a collection.
    End If
    If lFlags And EVT_ERROR Then
    ' An error occurred in the event.
    End If

    Exit Sub
    Errorhandler:
    'Log any errors that occur in this subroutine
    Call ErrorLog("ProcessAbortSave", CStr(Err.Number) & vbTab & Err.Description, bstrURLItem, lFlags)
    End Sub


    Function ProcessBeginDelete(ByVal pEventInfo As Exoledb.IExStoreEventInfo, ByVal bstrURLItem As String, ByVal lFlags As Long) As Boolean

    'This function is called when the Item is being deleted and the OnSyncDelete
    'event is fired for the first time in this event sink. Returns True if
    'successful, False if not.

    Dim pDispEventInfo As Exoledb.IExStoreDispEventInfo 'Declare a pointer to the interface that returns information about the executing store event.
    Dim recItem As ADODB.Record 'Record Object that will point to the item that triggered this event.
    '============================================================================================
    'ADDED BY SUMATRA
    ProcessBeginDelete = True
    Exit Function

    On Error GoTo Errorhandler

    'Assume that the function is successful. If any checks which may be coded below fail,
    ' or if an error occurs, then return False, which would cause the transaction to be aborted.
    ProcessBeginDelete = True

    'Write to the log file that this function has been called.
    Call EventLog("OnSyncDelete", bstrURLItem, lFlags, "Begin Phase")

    Set pDispEventInfo = pEventInfo 'Assign the passed IExStoreEventInfo object reference
    Set recItem = pDispEventInfo.EventRecord 'get the Record object bound to the item that triggered the event

    'Evaluate the different scenarios in which the delete might have been triggered.
    If lFlags And EVT_MOVE Then
    'The item was moved over resulting in an implicit delete.
    'Some role checking can be done - like below
    'If GetSecurityCallContext.IsSecurityEnabled Then
    'If Not GetSecurityCallContext.IsCallerInRole("Example Role") Then
    ''User is not in a defined role. Handle the condition here
    ''like preventing the delete by aborting the transaction; i.e.
    'pDispEventInfo.AbortChange
    'End If
    'End If
    'The item can be processed below.
    With recItem
    'Access the item's properties, do some actions etc.
    End With
    End If
    'The following blocks of code are similar to the previous one. Similar code can be applied
    'here as shown above, like role checking etc.
    If lFlags And EVT_COPY Then
    'The item was copied over resulting in an implicit delete.
    End If
    If lFlags And EVT_IS_COLLECTION Then
    'The item being deleted is a collection.
    End If
    If lFlags And EVT_INVALID_URL Then
    ' The URL passed to the sink as invalid.
    End If
    If lFlags And EVT_ERROR Then
    'An error occurred in the event.
    End If

    Exit Function
    Errorhandler:
    'Some error has occurred. The function may return False (as in the next line) so that the delete can be aborted.
    'ProcessBeginSave = False
    'Log any errors that occur in this function.
    Call ErrorLog("ProcessBeginDelete", CStr(Err.Number) & vbTab & Err.Description, bstrURLItem, lFlags)
    End Function


    Sub ProcessCommitDelete(ByVal pEventInfo As Exoledb.IExStoreEventInfo, ByVal bstrURLItem As String, ByVal lFlags As Long)

    'This function is called after the deletion of the Item has been committed.
    'NOTE: The item can no longer be changed (read-only)

    Dim pDispEventInfo As Exoledb.IExStoreDispEventInfo 'Declare a pointer to the interface that returns information about the executing store event.
    Dim recItem As ADODB.Record 'Record Object that will point to the item that triggered this event.
    '============================================================================================
    'ADDED BY SUMATRA
    Exit Sub

    On Error GoTo Errorhandler

    'Write to the log file that this subroutine has been called.
    Call EventLog("OnSyncDelete", bstrURLItem, lFlags, "Commit Phase")


    Set pDispEventInfo = pEventInfo 'Assign the passed IExStoreEventInfo object reference
    Set recItem = pDispEventInfo.EventRecord 'get the Record object bound to the item that triggered the event

    'Evaluate the different scenarios in which the delete might have been triggered.
    If lFlags And EVT_MOVE Then
    'The item was moved over resulting in an implicit delete.
    End If
    If lFlags And EVT_COPY Then
    'The item was copied over resulting in an implicit delete.
    End If
    If lFlags And EVT_IS_COLLECTION Then
    'The item being deleted is a collection.
    End If
    If lFlags And EVT_INVALID_URL Then
    ' The URL passed to the sink as invalid.
    End If
    If lFlags And EVT_ERROR Then
    'An error occurred in the event.
    End If

    Exit Sub
    Errorhandler:
    'Log any errors that occur in this subroutine
    Call ErrorLog("ProcessCommitDelete", CStr(Err.Number) & vbTab & Err.Description, bstrURLItem, lFlags)
    End Sub


    Sub ProcessAbortDelete(ByVal pEventInfo As Exoledb.IExStoreEventInfo, ByVal bstrURLItem As String, ByVal lFlags As Long)

    'This subroutine is called when deletion of the item is aborted.

    Dim pDispEventInfo As Exoledb.IExStoreDispEventInfo 'Declare a pointer to the interface that returns information about the executing store event.
    Dim recItem As ADODB.Record 'Record Object that will point to the item that triggered this event.
    '============================================================================================
    'ADDED BY SUMATRA
    Exit Sub

    On Error GoTo Errorhandler

    'Write to the log file that this subroutine has been called.
    Call EventLog("OnSyncDelete", bstrURLItem, lFlags, "Abort Phase")

    Set pDispEventInfo = pEventInfo 'Assign the passed IExStoreEventInfo object reference
    Set recItem = pDispEventInfo.EventRecord 'get the Record object bound to the item that triggered the event

    'Evaluate the different scenarios in which the delete might have been triggered.
    If lFlags And EVT_MOVE Then
    'The item was moved over resulting in an implicit delete.
    End If
    If lFlags And EVT_COPY Then
    'The item was copied over resulting in an implicit delete.
    End If
    If lFlags And EVT_IS_COLLECTION Then
    'The item being deleted is a collection.
    End If
    If lFlags And EVT_INVALID_URL Then
    ' The URL passed to the sink as invalid.
    End If
    If lFlags And EVT_ERROR Then
    'An error occurred in the event.
    End If

    Exit Sub
    Errorhandler:
    'Log any errors that occur in this subroutine
    Call ErrorLog("ProcessAbortDelete", CStr(Err.Number) & vbTab & Err.Description, bstrURLItem, lFlags)
    End Sub



    Sub ErrorLog(EventName As String, errString As String, ByVal bstrURLItem As String, Optional ByVal lFlags As Long = 0)

    ' JEFFGA
    Exit Sub
    ' JEFFGA

    If Not PERFORM_ERROR_LOGGING Then 'Check if logging is turned off
    Exit Sub ' If so, do not perform logging
    End If
    'this function writes to the log file details of any error that occurred. It is called from the error handler in all events.

    Dim FSO As Scripting.FileSystemObject
    Dim WinTmpFile As String
    Dim OnSaveFile As Scripting.TextStream


    Set FSO = New Scripting.FileSystemObject 'Instantiate the FileSystemObject
    ' WinTmpFile = FSO.GetAbsolutePathName("") & "\" & LogFile
    ' WinTmpFile = FSO.GetSpecialFolder(SystemFolder).Path & "\" & LogFile 'Set the path of the log file to be in the Windows System Folder
    WinTmpFile = "C:\TEMP\" & LogFile

    Set OnSaveFile = FSO.OpenTextFile(WinTmpFile, 8, True) 'Open the file for Appending
    OnSaveFile.WriteLine (String(35, "*") & "E R R O R " & String(35, "*")) 'Write a separator line
    OnSaveFile.WriteLine Format(Now, DATE_TIME_FORMAT) 'Write the current date and time
    OnSaveFile.WriteLine (" Event Name :" & vbTab & EventName) 'Write the Event Name
    OnSaveFile.WriteLine (" URL of Source Item:" & vbTab & bstrURLItem) 'Write the URL of the Event source
    OnSaveFile.WriteLine (ReturnEXOLEDBFlags(lFlags)) 'Write the flags that are currently set
    OnSaveFile.WriteLine (errString) 'Write the Error Text
    OnSaveFile.WriteLine (String(80, "-")) 'Write a separator line to the file
    OnSaveFile.WriteBlankLines (1) 'Insert a blank line into the file
    OnSaveFile.Close 'Close the log file
    Set FSO = Nothing

    End Sub


    Sub EventLog(EventName As String, ByVal bstrURLItem As String, Optional ByVal lFlags As Long = 0, Optional bstrComment As String = "")

    ' JEFFGA
    Exit Sub
    ' JEFFGA

    'This function writes to the log file details of an event being executed. It is called from each event procedure.
    If Not PERFORM_FILE_LOGGING Then 'Check if logging is turned off
    Exit Sub ' If so, do not perform logging
    End If

    Dim FSO As Scripting.FileSystemObject
    Dim WinTmpFile As String
    Dim OnSaveFile As Scripting.TextStream

    Set FSO = New Scripting.FileSystemObject 'Instantiate the FileSystemObject
    'WinTmpFile = FSO.GetAbsolutePathName("") & "\" & LogFile
    WinTmpFile = "C:\TEMP\" & LogFile

    ' WinTmpFile = FSO.GetSpecialFolder(SystemFolder).Path & "\" & LogFile 'Set the path of the log file to be in the Windows System Folder
    Set OnSaveFile = FSO.OpenTextFile(WinTmpFile, 8, True) 'Open the file for Appending
    OnSaveFile.WriteLine Format(Now, DATE_TIME_FORMAT) 'Write the current date and time
    OnSaveFile.WriteLine (" Event Name:" & EventName) 'Write the Event Name
    OnSaveFile.WriteLine (" URL of Source Item:" & vbTab & bstrURLItem) 'Write the URL of the Event source
    OnSaveFile.WriteLine (ReturnEXOLEDBFlags(lFlags)) 'Write the flags that are currently set
    OnSaveFile.WriteLine (" COMMENT:" & vbTab & bstrComment) 'Write the comment, if any
    OnSaveFile.WriteLine (String(80, "-")) 'Write a separator line to the file
    OnSaveFile.WriteBlankLines (1) 'Insert a blank line into the file
    OnSaveFile.Close 'Close the log file
    Set FSO = Nothing

    End Sub


    Function ReturnEXOLEDBFlags(lFlags As Long, Optional blnFreshy As Boolean = True) As String

    'This function returns a string containing a list of all the flags that are currently set.
    Dim strBuff As String
    strBuff = " Flags (" & "0x" & Hex(lFlags) & "):"
    If (lFlags And EVT_NEW_ITEM) > 0 Then
    strBuff = strBuff & " EVT_NEW_ITEM "
    End If
    If (lFlags And EVT_IS_COLLECTION) > 0 Then
    strBuff = strBuff & " EVT_IS_COLLECTION "
    End If
    If (lFlags And EVT_REPLICATED_ITEM) > 0 Then
    strBuff = strBuff & " EVT_REPLICATED_ITEM "
    End If
    If (lFlags And EVT_IS_DELIVERED) > 0 Then
    strBuff = strBuff & " EVT_IS_DELIVERED "
    End If
    If (lFlags And EVT_INITNEW) > 0 Then
    strBuff = strBuff & " EVT_INITNEW "
    End If
    If (lFlags And EVT_MOVE) > 0 Then
    strBuff = strBuff & " EVT_MOVE "
    End If
    If (lFlags And EVT_COPY) > 0 Then
    strBuff = strBuff & " EVT_COPY "
    End If
    If (lFlags And EVT_SYNC_BEGIN) > 0 Then
    strBuff = strBuff & " EVT_SYNC_BEGIN "
    End If
    If (lFlags And EVT_SYNC_COMMITTED) > 0 Then
    strBuff = strBuff & " EVT_SYNC_COMMITTED "
    End If
    If (lFlags And EVT_SYNC_ABORTED) > 0 Then
    strBuff = strBuff & " EVT_SYNC_ABORTED "
    End If
    If (lFlags And EVT_INVALID_SOURCE_URL) > 0 Then
    strBuff = strBuff & " EVT_INVALID_SOURCE_URL "
    End If
    If (lFlags And EVT_INVALID_URL) > 0 Then
    strBuff = strBuff & " EVT_INVALID_URL "
    End If
    ReturnEXOLEDBFlags = strBuff

    End Function

    ReplyDelete