简体   繁体   中英

Multiple user writing to a single log text file

Im trying to get a log system working in an application in MS Access 2016 whenever any user make any action such as login, editing etc.

So far the code I wrote is fairly simple by using open statement,

Public Sub WriteLog(ByVal strContent As String)
    fileLog = FreeFile
    Open "D:/log.txt" For Output As fileLog

    Print #fileLog, strContent
    Close #fileLog
End Sub

This is not good because I intent to write the log file in a shared network, which mean many users may simultaneously open the file to write. This will definitely throw error. I thought of doing some queuing to write to the file but havent come to any solution. Is it just impossible to do this?

Edited:

Recursively check if file open and write to file after the file is closed, a way to somehow 'queue' to write to a file. Maybe need to add some code to make sure a limit to recursively execute this function.

Function AvailableToWrite()

    ' Test to see if the file is open.
    If IsFileOpen("D:\log.txt") Then
        AvailableToWrite = IsFileOpen() ' Recursively check until file is closed
    Else
        AvailableToWrite = True
    End If

End Function

Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer

    On Error Resume Next
    filenum = FreeFile()
    ' Attempt to open the file and lock it.
    Open filename For Input Write As #filenum
    Close filenum
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.

    ' Check to see which error occurred.
    Select Case errnum

        ' No error occurred.
        ' File is NOT already open by another user.
        Case 0
         IsFileOpen = False

        ' Error number for "Permission Denied."
        ' File is already opened by another user.
        Case 70
            IsFileOpen = True

    End Select

End Function

Usually, writing a line to text file takes only a split second.

Thus, you may simply, in a loop, catch the error if your function can't write to the file, wait a tiny random length split second, then try again until success.

Addendum

Method for a variable delay in case of a block before a new attempt is done:

' Function to run a sequence of updates at random intervals for a preset
' duration while handling any concurrency issue that may arise.
' Run the function concurrently in two or more instances of Microsoft Access.
'
' Output logs the updates and lists the errors encountered when an update
' collides with an ongoing update from (one of) the other instance(s).
'
' 2016-01-31. Gustav Brock, Cactus Data ApS, CPH.
'
Public Sub ConcurrencyAwareTest()

    Dim db          As DAO.Database
    Dim rs          As DAO.Recordset
    Dim fd          As DAO.Field

    Dim StopTime    As Single
    Dim Delay       As Single
    Dim Attempts    As Long
    Dim LoopStart   As Single
    Dim LoopEnd     As Single
    Dim Loops       As Long

    Dim SQL         As String
    Dim Criteria    As String
    Dim NewValue    As Boolean

    SQL = "Select * From " & TableName & ""
    Criteria = KeyName & " = " & CStr(KeyValue) & ""

    Set db = CurrentDb
    Set rs = db.OpenRecordset(SQL, dbOpenDynaset, dbSeeChanges)

    rs.FindFirst Criteria
    Set fd = rs.Fields(FieldName)

    ' Set time for the test to stop.
    StopTime = Timer + Duration
    ' Let SetEdit and GetUpdate print debug information.
    DebugMode = True

    ' At random intervals, call updates of the field until StopTime is reached.
    While Timer < StopTime

        ' Postpone the next update.
        Delay = Timer + Rnd / 100
        While Timer < Delay
            DoEvents
        Wend
        Loops = Loops + 1
        LoopStart = Timer
        Debug.Print Loops, LoopStart

        ' Perform update.
        NewValue = Not fd.Value
        Do
            ' Count the attempts to update in this loop.
            Attempts = Attempts + 1
            ' Attempt edit and update until success.
            SetEdit rs
                fd.Value = NewValue
        Loop Until GetUpdate(rs)

        LoopEnd = Timer
        ' Print loop duration in milliseconds and edit attempts.
        Debug.Print , LoopEnd, Int(1000 * (LoopEnd - LoopStart)), Attempts
        Attempts = 0

    Wend
    rs.Close

    DebugMode = False
    Set fd = Nothing
    Set rs = Nothing
    Set db = Nothing

End Sub

The purpose was to prove the concept described in the article here:

Handle concurrent update conflicts in Access silently

Table Structure:

表


Procedure to log events

Sub WriteLog(Optional note As String)
   'add event to log
    DoCmd.SetWarnings False
    DoCmd.RunSQL "INSERT INTO tblLog (logNote) SELECT """ & Replace(note,"""","'") & """"
    DoCmd.SetWarnings True

    'export to text file
    On Error Resume Next 'ignore error
    DoCmd.TransferText acExportDelim,,"tblLog","c:\LogFile.txt",True
    On Error Goto 0 'back to normal error handling
    Debug.Print "Wrote to log & updated text file."
End Sub

Usage:

WriteLog "Your note here" : saves a record with current date/time plus "Your note here"
WriteLog : saves a record with only date/time


Example of (my) filled table:

(Click to Englarge)
IMG


Example of text file:

It's comma-separated by default (so it could be opened in Excel if you wanted) but with a couple extra steps could be exported in "fixed width" instead, by creating a specification and also using the acExportFixed flag.

日志

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM