我试图在任何用户进行任何操作(例如登录,编辑等)时,在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
答案 0 :(得分:4)
通常,在文本文件中写一行只需要一瞬间。
因此,您可以简单地在循环中捕获错误,如果您的函数无法写入文件,请等待一小段随机长度,然后重试直到成功。
<强>附录强>
在新尝试完成之前块发生变量延迟的方法:
' 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
目的是证明这篇文章中描述的概念:
答案 1 :(得分:3)
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
标志。