son - reparar archivos de excel dañados gratis
Detecta si el libro de Excel ya está abierto (7)
En VBA, abrí un archivo de MS Excel llamado "myWork.XL" programáticamente.
Ahora me gustaría un código que me pueda decir sobre su estado, ya sea abierto o no. Es decir, algo así como IsWorkBookOpened("myWork.XL)
?
¿Qué sucede si desea verificar sin crear otra instancia de Excel?
Por ejemplo, tengo una macro de Word (que se ejecuta repetidamente) que necesita extraer datos de una hoja de cálculo de Excel. Si la hoja de cálculo ya está abierta en una instancia existente de Excel, preferiría no crear una nueva instancia.
Encontré una gran respuesta aquí que construí en: http://www.dbforums.com/microsoft-access/1022678-how-check-wether-excel-workbook-already-open-not-search-value.html
Gracias a MikeTheBike y kirankarnati
Function WorkbookOpen(strWorkBookName As String) As Boolean
''Returns TRUE if the workbook is open
Dim oXL As Excel.Application
Dim oBk As Workbook
On Error Resume Next
Set oXL = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
''Excel is NOT open, so the workbook cannot be open
Err.Clear
WorkbookOpen = False
Else
''Excel is open, check if workbook is open
Set oBk = oXL.Workbooks(strWorkBookName)
If oBk Is Nothing Then
WorkbookOpen = False
Else
WorkbookOpen = True
Set oBk = Nothing
End If
End If
Set oXL = Nothing
End Function
Sub testWorkbookOpen()
Dim strBookName As String
strBookName = "myWork.xls"
If WorkbookOpen(strBookName) Then
msgbox strBookName & " is open", vbOKOnly + vbInformation
Else
msgbox strBookName & " is NOT open", vbOKOnly + vbExclamation
End If
End Sub
Este es un poco más fácil de entender:
Dim location As String
Dim wbk As Workbook
location = "c:/excel.xls"
Set wbk = Workbooks.Open(location)
''Check to see if file is already open
If wbk.ReadOnly Then
ActiveWorkbook.Close
MsgBox "Cannot update the excelsheet, someone currently using file. Please try again later."
Exit Sub
End If
Me gustaría ir con esto:
Public Function FileInUse(sFileName) As Boolean
On Error Resume Next
Open sFileName For Binary Access Read Lock Read As #1
Close #1
FileInUse = IIf(Err.Number > 0, True, False)
On Error GoTo 0
End Function
como sFileName, debe proporcionar una ruta directa al archivo, por ejemplo:
Sub Test_Sub()
myFilePath = "C:/Users/UserName/Desktop/example.xlsx"
If FileInUse(myFilePath) Then
MsgBox "File is Opened"
Else
MsgBox "File is Closed"
End If
End Sub
Para mis aplicaciones, generalmente quiero trabajar con un libro de trabajo en lugar de solo determinar si está abierto. Para ese caso, prefiero omitir la función booleana y simplemente devolver el libro de trabajo.
Sub test()
Dim wb As Workbook
Set wb = GetWorkbook("C:/Users/dick/Dropbox/Excel/Hoops.xls")
If Not wb Is Nothing Then
Debug.Print wb.Name
End If
End Sub
Public Function GetWorkbook(ByVal sFullName As String) As Workbook
Dim sFile As String
Dim wbReturn As Workbook
sFile = Dir(sFullName)
On Error Resume Next
Set wbReturn = Workbooks(sFile)
If wbReturn Is Nothing Then
Set wbReturn = Workbooks.Open(sFullName)
End If
On Error GoTo 0
Set GetWorkbook = wbReturn
End Function
Prueba esto:
Option Explicit
Sub Sample()
Dim Ret
Ret = IsWorkBookOpen("C:/myWork.xlsx")
If Ret = True Then
MsgBox "File is open"
Else
MsgBox "File is Closed"
End If
End Sub
Function IsWorkBookOpen(FileName As String)
Dim ff As Long, ErrNo As Long
On Error Resume Next
ff = FreeFile()
Open FileName For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function
Si está abierto, estará en la colección de libros de trabajo:
Function BookOpen(strBookName As String) As Boolean
Dim oBk As Workbook
On Error Resume Next
Set oBk = Workbooks(strBookName)
On Error GoTo 0
If oBk Is Nothing Then
BookOpen = False
Else
BookOpen = True
End If
End Function
Sub testbook()
Dim strBookName As String
strBookName = "myWork.xls"
If BookOpen(strBookName) Then
MsgBox strBookName & " is open", vbOKOnly + vbInformation
Else
MsgBox strBookName & " is NOT open", vbOKOnly + vbExclamation
End If
End Sub
Verifica esta función
''********************************************************************************************************************************************************************************
''Function Name : IsWorkBookOpen(ByVal OWB As String)
''Function Description : Function to check whether specified workbook is open
''Data Parameters : OWB:- Specify name or path to the workbook. eg: "Book1.xlsx" or "C:/Users/Kannan.S/Desktop/Book1.xlsm"
''********************************************************************************************************************************************************************************
Function IsWorkBookOpen(ByVal OWB As String) As Boolean
IsWorkBookOpen = False
Dim WB As Excel.Workbook
Dim WBName As String
Dim WBPath As String
Err.Clear
On Error Resume Next
OWBArray = Split(OWB, Application.PathSeparator)
Set WB = Application.Workbooks(OWBArray(UBound(OWBArray)))
WBName = OWBArray(UBound(OWBArray))
WBPath = WB.Path & Application.PathSeparator & WBName
If Not WB Is Nothing Then
If UBound(OWBArray) > 0 Then
If LCase(WBPath) = LCase(OWB) Then IsWorkBookOpen = True
Else
IsWorkBookOpen = True
End If
End If
Err.Clear
End Function