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

In VBA, ho aperto un file MS Excel denominato “myWork.XL” a livello di codice.

Ora vorrei un codice che mi possa dire del suo stato, che sia aperto o meno. Cioè qualcosa come IsWorkBookOpened("myWork.XL) ?

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 voglio lavorare con una cartella di lavoro piuttosto che determinare se è aperta. In questo caso, preferisco saltare la funzione 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 è aperto, sarà nella raccolta 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 un percorso 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 succede se si desidera verificare senza creare un’altra istanza di Excel?

Ad esempio, ho una macro di Word (che viene 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 un’ottima risposta qui che ho creato su: http://www.dbforums.com/microsoft-access/1022678-how-check-wether-excel-workbook-already-open-not-search-value.html

Grazie a Mike TheBike e 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 

Acquista questa funzione

 '******************************************************************************************************************************************************************************** '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