Vba 如何确定文件是否被其他进程使用？

我想将数据保存到Excel单元格，但如果Excel文件由其他进程打开，则会失败，因此，在将数据写入Excel单元格之前，如何确定该文件是否由其他进程使用

---

谢谢，

MS提供了一个很好的示例，说明如何在尝试使用他们编写的名为FileLocked的函数打开文件之前检查文件是否可以访问

Sub YourMacro()
   Dim strFileName As String
   ' Full path and name of file.
   strFileName = "C:\test.doc"
   ' Call function to test file lock.
   If Not FileLocked(strFileName) Then
      ' If the function returns False, open the document.
      Documents.Open strFileName
   End If
End Sub

下面是函数（由MS编写）：

函数FileLocked（strFileName作为字符串）作为布尔值
出错时继续下一步
'如果文件已由另一个进程打开，
'并且不允许指定的访问类型，
'打开操作失败，出现错误。
打开二进制访问读写锁定读写为#1的strFileName
关闭#1
'如果发生错误，则文档当前处于打开状态。
如果错误号为0，则
'显示错误号和说明。
MsgBox“Error#”和Str（Err.Number）&“-”和Err.Description
FileLocked=True
呃，明白了
如果结束
端函数

---

来自Microsoft的参考资料：

根据Issun的回答，如果您发现Microsoft的FileLocked功能不起作用（例如，我发现它会错误地宣称当前正在录制的WTV文件未锁定），那么您可以使用此方法，而此方法更为残忍：

Function FileLocked(sFilename) As Boolean
    Dim oFile, sNewFile, iCount
    If fso.FileExists(sFilename) = False Then
        FileLocked = False
        Exit Function
    End If
    ' Pick a random, unused, temp name
    iCount = 0
    Do
        sNewFile = sFilename & ".tmp" & iCount
        iCount = iCount + 1
    Loop Until fso.FileExists(sNewFile) = False
    ' Try to rename it to that. If it fails, then it is in use
    On Error Resume Next
    fso.MoveFile sFilename, sNewFile
    If Err.Number = 0 Then
        ' It moved okay, so rename it back
        fso.MoveFile sNewFile, sFilename
        FileLocked = False
    Else
        FileLocked = True
    End If
    On Error Goto 0     
End Function

---

+1我已多次使用此技术检查共享网络上的文件是否已被使用（尽管我唯一担心的是该文件已在Excel中打开）。如果此答案或其他答案有效，您可以通过选择左上角的箭头“接受”它作为答案。谢谢

Function FileLocked(sFilename) As Boolean
    Dim oFile, sNewFile, iCount
    If fso.FileExists(sFilename) = False Then
        FileLocked = False
        Exit Function
    End If
    ' Pick a random, unused, temp name
    iCount = 0
    Do
        sNewFile = sFilename & ".tmp" & iCount
        iCount = iCount + 1
    Loop Until fso.FileExists(sNewFile) = False
    ' Try to rename it to that. If it fails, then it is in use
    On Error Resume Next
    fso.MoveFile sFilename, sNewFile
    If Err.Number = 0 Then
        ' It moved okay, so rename it back
        fso.MoveFile sNewFile, sFilename
        FileLocked = False
    Else
        FileLocked = True
    End If
    On Error Goto 0     
End Function