【译文】用VBA代码检查文件是不是被锁定

原作者：Ben Clothier　　翻译：周芳     

【译文】用VBA代码检查文件是不是被锁定了（即文件是否处于打开编辑状态）  

       在我们的一个客户端应用中,我们建立了一个电子邮件模板,有时需要发送附件。在邮件发送之前，我们的客户端用一种方式预览这个附件。那就会形成一个进退两难的局面：如果他们可以预览和编辑这个文件，,我们当然是不希望继续和尝试把打开的文件附加到邮件,因此就产生了一个问题。因此我们需要一种方法来检查是否文件可能已经打开,来提醒用户关闭文件，当证实被关闭再发送电子邮件。

 

       获得排他性

 

       基于微软Windows的多用户性质,现在没有一个简单的方法来判断一个无论什么类型的文件是否是打开的。然而,我们至少可以一个近似此功能的操作来使得只有在我们的代码中才可以打开文件,如果我们成功证明这一点,那对我们继续学习是有好处的。

 

       下面介绍一下IsFileLocked函数

 

        当我们用记事本打开一个文本文件,即使我们破坏这个文件记事本也不会锁定它。在这种情况下,当文件是被文本编辑器打开时，复制或阅读文件是不会有害处的。因此，在这种情况下，IsFileLocked()方法将适用于任何一个被记事本打开的.txt文件。一般认为是没关系的。当然,人们不应该尝试着去改动上述文件,但那不是我们在这里做的。另一方面,特别是Word,Excel将锁定他们的文档，因此试图复制或读文件可能是不可取的而且将会威胁文件的完整。在这种情况下,我们试图获得一个排它锁将不能成功,只能让我们来提醒用户自己在进行下一步操作之前去关闭文件不然就取消。

 

       唯一需要特别提醒的是:这个程序是不适合检查是否一个文件被其他进程打开,比如在后台运行的任务。这个锁会被锁住然后再以毫秒为单位释放，因此这个方法是很合适的。为了检查用户是否已经打开一个文件,这应该是足够了

 

Public Function IsFileLocked(PathName As String) As Boolean

On Error GoTo ErrHandler

 Dim i As Integer

 

 If Len(Dir$(PathName)) Then

 Else

 End If

 

ExitProc:

 On Error GoTo 0

 Exit Function

 

ErrHandler:

 Select Case Err.Number

 Resume ExitProc

 Resume

End Function

 

       如果你有多个文件被打开呢?

 

        以上的代码让我们有了一个良好的开端,但我们也要处理可能有一个以上的文件被打开的情况,况且没有人会喜欢被多个对话框提醒，因此我们需要卷起这些对话框信息而成为一个单一的提示框,让用户可以只看到一个消息,但是提醒他们需要关闭所有被锁定的文件。下面是代码：

Public Function CheckForLockedFiles( Files() As String) As Boolean

On Error GoTo ErrHandler

 Dim i As Long

 Dim lngLocks As Long

 Dim strFiles() As String

 Dim strMessage As String

 

 Do

 Loop Until lngLocks = 0

 If lngLocks = 0 Then

 End If

 

ExitProc:

 On Error GoTo 0

 Exit Function

 

ErrHandler:

 Select Case Err.Number

 End Select

 Resume ExitProc

 Resume

End Function

【原文】

Checking if files are locked using VBA

In one of our client’s applications, we built an email template that sometimes may attach files to be sent out. Our client wanted a way to preview the attachment before they actually send the email. This created a dilemma – if they can preview and potentially edit the files, we certainly don’t want to continue and try to attach open files to an email, therefore creating a problem. So we needed a way to check whether files may be already open, alert the user to close the file, verify it’s closed then send the emails.

Get Exclusivity

Due to multitasking nature of Windows, there is no simple universal function to ask if a file, whatever type of file it may be, is open or not. However, we can at least approximate this functionality by attempting to open the file exclusively in our code and if we succeed, be reasonably sure that we are good to proceed onwards.

Introducing IsFileLocked() Function

When we open a text file with Notepad, Notepad does not place any locks on the file even when we dirty the file. In this situation, it does no harm to copy or read the file while it’s open by Notepad. Thus IsFileLocked() will return true for any .txt files opened by Notepad and in this situation, it’s generally OK. Of course, one shouldn’t try to write to the said file but that’s not what we are doing here. On the other hand, Word and Excel will place locks on their documents. Therefore trying to copy or read the file may be undesirable and threat it’s integrity. In this situation, our attempt to acquire an exclusive lock will fail, allowing us to alert the user to close the file themselves before proceeding further or cancel out.

The only significant caveat is that this procedure is not appropriate for checking whether a file is locked by other processes such as running background tasks. The locks can be acquired and released in milliseconds so calling the function is inherently racy. For purposes of checking whether users has a file open, this should be sufficient

Public Function IsFileLocked(PathName As String) As Boolean
On Error GoTo ErrHandler
  Dim i As Integer

  If Len(Dir$(PathName)) Then
    i = FreeFile()
    Open PathName For Random Access Read Write Lock Read Write As #i
    Lock i 'Redundant but let's be 100% sure
    Unlock i
    Close i
  Else
    Err.Raise 53
  End If

ExitProc:
  On Error GoTo 0
  Exit Function

ErrHandler:
  Select Case Err.Number
    Case 70 'Unable to acquire exclusive lock
      IsFileOpen = True
    Case Else
      MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
    End Select
  Resume ExitProc
  Resume
End Function

What if you have multiple files open?

That gets us to a good start but we also have to handle the fact that there may be more than one file open, and nobody likes being alerted by multiple dialogs. Thus we need to roll up the individual checks into a single message so the users can only see one message for all locked files that they may need to close. Here’s the code:

Public Function CheckForLockedFiles( _
  Files() As String _
) As Boolean
On Error GoTo ErrHandler
  Dim i As Long
  Dim lngLocks As Long
  Dim strFiles() As String
  Dim strMessage As String

  Do
    lngLocks = 0
    For i = 0 To UBound(Files)
      If IsFileOpen(Files(i)) Then
        ReDim Preserve strFiles(lngLocks)
        strFiles(lngLocks) = Files(i)
        lngLocks = lngLocks + 1
      End If
    Next
    If lngLocks Then
      strMessage = "The following files are in use. " & _
                   "Please close the application that may have it open." _
                   & vbNewLine & vbNewLine
      For i = 0 To UBound(strFiles)
        strMessage = strMessage & strFiles(i) & vbNewLine
      Next
      If vbCancel = MsgBox(strMessage, vbRetryCancel, "Files in use") Then
        CheckForLockedFiles = False
        Exit Do
      End If
    End If
  Loop Until lngLocks = 0
  If lngLocks = 0 Then
    CheckForLockedFiles = True
  End If

ExitProc:
  On Error GoTo 0
  Exit Function

ErrHandler:
  Select Case Err.Number
    Case 53 'File doesn't exist, ignore
      Resume Next
    Case Else
      MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
  End Select
  Resume ExitProc
  Resume
End Function