用于检查文本文件是否打开的 VBA 脚本

Question

我正在检查文件是否打开，即 .txt 文件

Private Sub CommandButton1_Click()
   Dim strFileName As String
   ' Full path and name of file.
   strFileName = "D:\te.txt"
   ' Call function to test file lock.
   If Not FileLocked(strFileName) Then
   ' If the function returns False, open the document.
      MsgBox "not open"
   Else
      MsgBox "open"
   End If

End Sub

Function FileLocked(strFileName As String) As Boolean
   On Error Resume Next
   ' If the file is already opened by another process,
   ' and the specified type of access is not allowed,
   ' the Open operation fails and an error occurs.
   Open strFileName For Binary Access Read Write Lock Read Write As #1
   Close #1
   ' If an error occurs, the document is currently open.
   If Err.Number <> 0 Then
      ' Display the error number and description.
      MsgBox "Error #" & Str(Err.Number) & " - " & Err.Description
      FileLocked = True
      Err.Clear
   End If
End Function

Answer 1

事实证明，使用记事本打开 .txt 时不会锁定文件，因此无法知道 .txt 文件是否打开。 因此，如果该 .txt 文件在 Wordpad 或 Sakura 等中打开，您的代码应该可以工作，或者至少来自网络的其他代码应该可以工作。

Answer 2

我发现如果使用 FileSystemObject 打开一个文本文件，那么该文件不会被锁定，并且仍然可以被其他用户编辑。 作为一种潜在的解决方法，您可以创建一个带有单个位的文件以指示另一个文件何时正在使用，并在您的代码中包括检查该位。 这是我的代码作为一个粗略的例子：

'FSO parameters
Const ForAppending = 8
Const ForReading = 1
Const ForWriting = 2

Sub WriteToFile()
    Set fso = CreateObject("Scripting.FileSystemObject")

    'Check the current lock bit (1 is locked, 0 is unlocked)
    Set FileLock = fso.OpenTextFile("C:\FileLock.txt", ForReading)
    Dim LockBit As Integer
        LockBit = FileLock.ReadAll
    FileLock.Close

    'If the bit is 1 (file in use) then wait 1 second and try again (up to 10 times)
    For try = 1 To 10
        If LockBit = 1 Then
            Application.Wait (Now + TimeValue("0:00:1"))
            Set FileLock = fso.OpenTextFile("C:\FileLock.txt", ForReading)
            LockBit = FileLock.ReadAll
            FileLock.Close
        Else: GoTo Line1 'when the bit is 0 (file available)
        End If
        If try = 10 Then
            MsgBox "File not available"
            Exit Sub
        End If
    Next try

Line1:
    Call LockTheFile(fso, True) 'Change the lock bit to "1" to show the file's in use
    Set WriteFile = fso.OpenTextFile("C:\WriteFile.txt", ForWriting)
        'Do what you will with the file
        MsgBox "Write Successful"
    WriteFile.Close
    Call LockTheFile(fso, False) 'Change the lock bit to "0" to show the file's available

End Sub

我把这个子分开，使主代码更加精简

Sub LockTheFile(fso, SetLock As Boolean)
    'Write "1" to a lock file to indicate the text file is in use, or "0" to indicate not in use
    Set BitFile = fso.CreateTextFile("C:\FileLock.txt", True)

    If SetLock = True Then
        BitFile.WriteLine "1"
    Else
        BitFile.WriteLine "0"
    End If

    BitFile.Close
End Sub