Verify no files are open in a folder

[oam]

I have a code that loops through all the workbooks in a folder and extracts information so before I can extract all the information I need to verify all file in the folder is closed and if they are not which one(s) are open.

Does anyone have a code that will check if a file in a folder is open and which one(s).

Thank you for your help and time

[Kenneth Hobs]

Sub Test_IsWorkbookOPen()  
  MsgBox IsWorkbookOpen("Personal.xls"), , "Personal.xls Open?"
  MsgBox IsWorkbookOpen("Personal.xlsb"), , "Personal.xlsb Open?"
End Sub


Function IsWorkbookOpen(stName As String) As Boolean
    Dim Wkb As Workbook
    On Error Resume Next ' In Case it isn't Open
    Set Wkb = Workbooks(stName)
    If Not Wkb Is Nothing Then IsWorkbookOpen = True
    'Boolean Function assumed To be False unless Set To True
End Function

[GTO]

...I need to verify all file in the folder is closed and if they are not which one(s) are open...

Greetings,

Just to clarify, are you asking to check if you have the files open in the current instance of excel, or (on a network) are we wondering if anyone else might have a particular file already open?

Mark

[oam]

GTO,

I wanted to know if any file(s) (Excel files) in a folder on the server are/is open. This particular folder contains time sheets and at the end of the week the excel code opens each file and extracts the input time and closes the file. If any one of the time sheet files is open at the time of extraction an error will occur and the time will not be extracted.

Does this make sense?
Thank you for your time.

[Kenneth Hobs]

Is it just one folder or with subfolders?

If all you need is data and sheet names and cell addresses are known, you can get the data even if open.

Even if open, you could copy the file and then get the data.

[oam]

Kenneth,

All the files are located in one folder, no sub folders.

When my current code runs and it tries to open the file to get the data it tells me the file is already open and asks if I want to reopen the file and when I say no, I get a Debug error.

Is there a way to get the data from each file with out opening the file?

Thank you Kenneth

[Kenneth Hobs]

To answer post #1 directly, here is how to check if any file open "by you". I will show code in a bit that shows how to check if any are open by anyone.

The last MsgBox in Main() shows 0 if none are open.

Be sure to set the reference as commented. Obviously, change the two input parameter values for fFiles() to suit.

Sub Main()  
  Dim a() As Variant
  'a() = fFiles("C:\MyFiles\Excel\old", "*.xls;*.xlsx")
  a() = fFiles("C:\MyFiles\Excel\gps", "*.xlsx")  
  MsgBox Join(a, vbLf)
  MsgBox NumFilesOpen(a)
End Sub


Function NumFilesOpen(filesArray()) As Long
  Dim x As Long, i As Long, s() As String
  x = 0
  For i = 0 To UBound(filesArray)
  s() = Split(filesArray(i), "\")
    If IsWorkbookOpen(s(UBound(s))) Then x = x + 1
  Next i
  NumFilesOpen = x
End Function


'Add reference: Microsoft Shell Controls and Automation
Function fFiles(aPath As Variant, Optional sFilters As String = "*.*") As Variant
  Dim objShell As Shell, objFolder As Folder
  Dim i As Long, a() As Variant
  Dim objFolderItems3 As FolderItems3
  
  'Dim ssfWINDOWS As Long, SHCONTF_NONFOLDERS As Long
  'ssfWINDOWS = 36  'c:\windows
  'SHCONTF_NONFOLDERS = 64  'Files
  
  Set objShell = New Shell
  Set objFolder = objShell.Namespace(aPath)
  If objFolder Is Nothing Then Exit Function
  Set objFolderItems3 = objFolder.Items
  If objFolderItems3 Is Nothing Then Exit Function
  
  objFolderItems3.Filter 64, sFilters
  With objFolderItems3
    If .Count = 0 Then Exit Function
    ReDim a(0 To .Count - 1)
    For i = 0 To .Count - 1
      a(i) = objFolderItems3.Item(i).Path
    Next i
  End With
  
  Set objFolderItems3 = Nothing
  Set objFolder = Nothing
  Set objShell = Nothing
  
  fFiles = a()
End Function


Function IsWorkbookOpen(stName As String) As Boolean
    Dim Wkb As Workbook
    On Error Resume Next ' In Case it isn't Open
    Set Wkb = Workbooks(stName)
    If Not Wkb Is Nothing Then IsWorkbookOpen = True
     'Boolean Function assumed To be False unless Set To True
End Function

[Kenneth Hobs]

Here is the more robust method. It needs the fFiles() routine from the last past. Since this uses some API commands, those have to go to the top of a Module. Like the last Main(), modify Main2() to suit.

Option Explicit



'===========================================
'http://www.xcelfiles.com/IsFileOpenAPI.htm
'===========================================


'// Note we use an Alias here as using the Actual
'// function name will not be accepted! ie underscore= "_lopen"




Public myDir As String
Public StartLine As Long
Public HowManyLines As Long
Public myFile
Public i
Public adate
Public ws
Public ActWork
Public NewWrkBk




Private Declare Function lOpen _
Lib "kernel32" _
Alias "_lopen" ( _
ByVal lpPathName As String, _
ByVal iReadWrite As Long) _
As Long




Private Declare Function lClose _
Lib "kernel32" _
Alias "_lclose" ( _
ByVal hFile As Long) _
As Long




'// Don't use these...here for Info only
Private Const OF_SHARE_COMPAT = &H0
Private Const OF_SHARE_DENY_NONE = &H40
Private Const OF_SHARE_DENY_READ = &H30
Private Const OF_SHARE_DENY_WRITE = &H20
'// Use the Constant below
'// OF_SHARE_EXCLUSIVE = &H10
'// OPENS the FILE in EXCLUSIVE mode,
'// denying other processes AND the current process both read and write
'// access to the file. If the file has been opened in any other mode for read or
'// write access _lopen fails. This is important as if you open the file in the
'// current process = Excel BUT loose its handle
'// then you CANNOT open it again in the SAME session!
Private Const OF_SHARE_EXCLUSIVE = &H10




Sub Main2()
  Dim a() As Variant
  a() = fFiles("C:\MyFiles\Excel\gps", "*.xlsx")
  MsgBox Join(a, vbLf)
  MsgBox NumFilesOpen2(a)
End Sub


Function NumFilesOpen2(filesArray()) As Long
  Dim x As Long, i As Long, s() As String
  x = 0
  Debug.Print UBound(filesArray)
  For i = 0 To UBound(filesArray)
  s() = Split(filesArray(i), "\")
    If IsFileAlreadyOpen(s(UBound(s))) Then x = x + 1
  Next i
  NumFilesOpen2 = x
End Function




'If the Function succeeds, the return value is a File handle.
'If the Function fails, the return value is HFILE_ERROR = -1
Function IsFileAlreadyOpen(strFullPath_FileName As String) As Boolean
  '// Ivan F Moala
  '// http://www.xcelfiles.com
  Dim hdlFile As Long
  Dim lastErr As Long
  
  hdlFile = -1
  
  '// Open file for Read/Write and Exclusive Sharing.
  hdlFile = lOpen(strFullPath_FileName, OF_SHARE_EXCLUSIVE)
  '// If we can't open the file, get the last error.
  If hdlFile = -1 Then
    lastErr = Err.LastDllError
    Else
      '// Make sure we close the file on success!
      lClose (hdlFile)
  End If
  
  '// Check for sharing violation error.
  IsFileAlreadyOpen = (hdlFile = -1) And (lastErr = 32)


End Function

[GTO]

Hi All:

As it appears we are only retrieving data and not writing, I was going to suggest something like:

Sub example()
Const PATH As String = "R:\My\Path\"
  
Dim FSO As Object       ' Scripting.FileSystemObject
Dim fsoFile As Object   '  Scripting.File
Dim WB As Workbook
  
  Set FSO = CreateObject("Scripting.FileSystemObject")
  
  If FSO.FolderExists(PATH) Then
    For Each fsoFile In FSO.GetFolder(PATH).Files
      If Not StrComp(Mid$(fsoFile.Name, InStrRev(fsoFile.Name, "."), 4), ".xls", vbTextCompare) And Not Left$(fsoFile.Name, 2) = "~$" Then
        Set WB = Application.Workbooks.Open(fsoFile.PATH, ReadOnly:=True)
        MsgBox "Do stuff here with " & WB.Name & ", like get the value from a cell on the first sheet: " & WB.Worksheets(1).Range("A2").Value, vbInformation, vbNullString
        WB.Saved = True
        WB.Close False
      End If
    Next
  End If
  
End Sub

...where we simply open the file read-only and bypass any warnings even if someone else has the file open. Of course if they do, and we are worried that they might change data, then of course as Kenneth has shown, checking to see if the file is already open would be needed. Unfortunately, I couldn't really test mine thoroughly, as heretofore I recall that if you did not indicate Read-Only, then the dialog/warning the OP indicates would pop-up. Testing just now though, even setting Read-Only to False opens the file Read-Only! (And yes, another user has the file open on another PC. I'm currently using Excel 2010 32-bit in WIN7 if any of that matters).

In close, I then tacked in Kenneth's code from Ivan and it indeed returns correctly

Thank you Kenneth, as neither link works and that is a nice bit of code to hang onto!

Mark

[Kenneth Hobs]

Thanks Mark. That is why I like helping. I learn something sometimes too.

[oam]

Kenneth,

Thank you very much for your help on this matter, it works well.