多个用户写入单个日志文本文件

Question

每当任何用户进行任何操作（例如登录、编辑等）时，我都会尝试让日志系统在 MS Access 2016 的应用程序中运行。

到目前为止，我使用open语句编写的代码相当简单，

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

    Print #fileLog, strContent
    Close #fileLog
End Sub

这不好，因为我打算在共享网络中写入日志文件，这意味着许多用户可能同时打开文件进行写入。 这肯定会抛出错误。我想过做一些排队来写入文件，但还没有找到任何解决方案。这是不可能的吗？

已编辑：

递归检查文件是否打开并在文件关闭后写入文件，这是一种以某种方式“排队”写入文件的方法。可能需要添加一些代码来确保递归执行此函数的限制。

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

Answer 1

通常，将一行写入文本文件只需一瞬间。

因此，如果您的函数无法写入文件，您可以简单地在循环中捕获错误，等待一小段随机长度，然后重试直到成功。

附录

在完成新尝试之前发生阻塞的情况下可变延迟的方法：

' 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

目的是为了证明这里文章中描述的概念：

Handle concurrent update conflicts in Access silently

Answer 2

表结构：

---

记录事件的过程

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

用法：

WriteLog "Your note here" ：保存一条带有当前日期/时间加上“您的注释”的记录
WriteLog ：保存一条只有日期/时间的记录

---

（我的）填充表示例：

_{（点击放大）}

---

文本文件示例：

默认情况下它是逗号分隔的（所以如果你愿意，它可以在 Excel 中打开）但是通过创建一个 规范 并且还可以通过几个额外的步骤以“固定宽度”导出使用acExportFixed 标志。