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:
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"
: saves a record with current date/time plus "Your note here"
WriteLog
: saves a record with only date/time
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.