Esta función determina si se puede acceder a un archivo de interés en el modo 'escritura'. Esto no es exactamente lo mismo que determinar si un archivo está bloqueado por un proceso. Aún así, puede encontrar que funciona para su situación. (Al menos hasta que aparezca algo mejor.)
Esta función indicará que el acceso 'de escritura' no es posible cuando un archivo está bloqueado por otro proceso. Sin embargo, no puede distinguir esa condición de otras condiciones que impiden el acceso de "escritura". Por ejemplo, el acceso 'de escritura' tampoco es posible si un archivo tiene su bit de solo lectura o posee permisos restrictivos NTFS. Todas estas condiciones darán como resultado la "denegación de permiso" cuando se realice un intento de acceso de "escritura".
También tenga en cuenta que si un archivo está bloqueado por otro proceso, la respuesta devuelta por esta función es confiable solo en el momento en que se ejecuta la función. Entonces, los problemas de concurrencia son posibles.
Se produce una excepción si se encuentra cualquiera de estas condiciones: 'archivo no encontrado', 'ruta no encontrada' o 'nombre de archivo ilegal' ('nombre o número de archivo incorrecto').
Function IsWriteAccessible(sFilePath)
' Strategy: Attempt to open the specified file in 'append' mode.
' Does not appear to change the 'modified' date on the file.
' Works with binary files as well as text files.
' Only 'ForAppending' is needed here. Define these constants
' outside of this function if you need them elsewhere in
' your source file.
Const ForReading = 1, ForWriting = 2, ForAppending = 8
IsWriteAccessible = False
Dim oFso : Set oFso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Dim nErr : nErr = 0
Dim sDesc : sDesc = ""
Dim oFile : Set oFile = oFso.OpenTextFile(sFilePath, ForAppending)
If Err.Number = 0 Then
oFile.Close
If Err Then
nErr = Err.Number
sDesc = Err.Description
Else
IsWriteAccessible = True
End if
Else
Select Case Err.Number
Case 70
' Permission denied because:
' - file is open by another process
' - read-only bit is set on file, *or*
' - NTFS Access Control List settings (ACLs) on file
' prevents access
Case Else
' 52 - Bad file name or number
' 53 - File not found
' 76 - Path not found
nErr = Err.Number
sDesc = Err.Description
End Select
End If
' The following two statements are superfluous. The VB6 garbage
' collector will free 'oFile' and 'oFso' when this function completes
' and they go out of scope. See Eric Lippert's article for more:
' http://blogs.msdn.com/b/ericlippert/archive/2004/04/28/when-are-you-required-to-set-objects-to-nothing.aspx
'Set oFile = Nothing
'Set oFso = Nothing
On Error GoTo 0
If nErr Then
Err.Raise nErr, , sDesc
End If
End Function
Darin señala (en otra respuesta) que este módulo debe incluir: 'Const ForReading = 1, ForWriting = 2, ForAppending = 8' – Smandoli
@Smandoli - Gracias por traer esta omisión a mi atención. He actualizado el código en consecuencia. También tenga en cuenta mi comentario anterior a la configuración 'oFile' y' oFso' a 'Nothing' al final de la función. – DavidRR