PDA

View Full Version : [SOLVED] Verify no files are open in a folder



oam
08-31-2016, 09:50 PM
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
09-01-2016, 05:29 AM
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
09-01-2016, 09:08 AM
...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
09-01-2016, 02:02 PM
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
09-01-2016, 02:21 PM
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
09-01-2016, 03:05 PM
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
09-02-2016, 05:11 AM
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
09-02-2016, 05:26 AM
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
09-02-2016, 08:55 AM
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 :cloud9:

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

Mark

Kenneth Hobs
09-02-2016, 09:11 AM
Thanks Mark. That is why I like helping. I learn something sometimes too.

oam
09-06-2016, 07:02 PM
Kenneth,

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