Rileva se la cartella di lavoro di Excel è già aperta

Ho aperto un file di MS Excel denominato "myWork.XL" attraverso la codifica. Ora voglio un codice che mi possa dire del suo status – sia aperto che no. In altre parole, se apro lo stesso file, dovresti dirmi che il file è già aperto.

Prova questo:

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 

Per le mie applicazioni, generalmente desidero lavorare con una cartella di lavoro piuttosto che determinare se è aperta. Per quel caso, preferisco saltare la function booleana e solo restituire la cartella di lavoro.

 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 

Se la sua apertura sarà nella collezione Workbooks:

 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 

Vorrei andare con questo:

 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 

come sFileName devi fornire il path diretto al file ad esempio:

 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 

Cosa fare se si desidera controllare senza creare un'altra istanza di Excel?

Ad esempio, ho una macro di Word (eseguita ripetutamente) che deve estrarre i dati da un foglio di calcolo di Excel. Se il foglio di calcolo è già aperto in un'istanza Excel esistente, preferirei non creare una nuova istanza.

Ho trovato una grande risposta qui che ho costruito su: http://www.dbforums.com/microsoft-access/1022678-how-check-wether-excel-workbook-already-open-not-search-value.html

Grazie a MikeTheBike e ai 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 

Questo è un po 'più facile da capire:

 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 

Controlla questa function

Funzione per verificare se una cartella di lavoro è aperta

codice da collegamento aggiunto

 '******************************************************************************************************************************************************************************** '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: "Nucleation.xlsx" or "C:\Users\Kannan.S\Desktop\Nucleation\Nucleation.xlsm" 'Created by : Kannan S 'Email : [email protected] 'Creation date : 13-Nov-2013 'Website : www.nucleation.in 'THIS CODE AND INFORMATION ARE PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT 'LIMITED TO THE IMPLIED WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE. 'Feel free to use the code as you wish but kindly keep this header section intact. 'Copyright © 2013 Nucleation. All Rights Reserved. '******************************************************************************************************************************************************************************** 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, "\") Set WB = Application.Workbooks(OWBArray(UBound(OWBArray))) WBName = OWBArray(UBound(OWBArray)) WBPath = WB.Path & "\" & 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