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

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

目的是证明这篇文章中描述的概念：

以静默方式处理Access中的并发更新冲突

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 ： 保存只有日期/时间的记录

---

（我的）填表的例子：

_{（点击Englarge）}

---

文本文件示例：

默认情况下它是逗号分隔的（因此可以在Excel中打开它），但是可以通过创建规范并使用acExportFixed标志以“固定宽度”导出一些额外的步骤。