VBA confirmar si un archivo .xlsm se encuentra abierto

Encontré una función que comprueba si un archivo excel se encuentra abierto, pero funciona perfecto si el mismo esta guardado en c:/, pero resulta que yo lo tengo guardado en un sharepoint en la web. Y cuando comprueba me tira Error 52. La función esta diseñada para corrobore con el archivo guardado en C:/, pero necesito que lo corrobore con el archivo guardado en la web. La función es la siguiente

Sub TestFileOpened()
    ' Test to see if the file is open.
    If IsFileOpen("c:\Book2.xls") Then
        ' Display a message stating the file in use.
        MsgBox "File already in use!"
        '
        ' Add code here to handle case where file is open by another
        ' user.
        '
    Else
        ' Display a message stating the file is not in use.
        MsgBox "File not in use!"
        ' Open the file in Microsoft Excel.
        Workbooks.Open "c:\Book2.xls"
        '
        ' Add code here to handle case where file is NOT open by another
        ' User.
        '
    End If
End Sub
' This function checks to see if a file is open or not. If the file is
' already open, it returns True. If the file is not open, it returns
' False. Otherwise, a run-time error occurs because there is
' some other problem accessing the file.
Function IsFileOpen(filename As String)
    Dim filenum As Integer, errnum As Integer
    On Error Resume Next   ' Turn error checking off.
    Filenum = FreeFile()   ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    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
        ' Another error occurred.
        Case Else
            Error errnum
    End Select
End Function

1 Respuesta

Respuesta
1

Abre el archivo y verifica la propiedad UserStatus

Workbooks.Open "c:\Book2.xls"           '  cambialo por la direccion web real
userAct=ActiveWorkbook.UserStatus
If Ubound(userAct)>1 then
   Msgbox "Ya esta abierto por otro usuario"
End if

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas