Can I stop vba code from running if one of the source workbook is open? - vba

Question

I am using a VBA script where the first worksheets of all workbooks saved in a specific folder are consolidated in one workbook. What I want is, if any source workbook is open while running this script, then I should get a prompt that 'source workbook is open' and the script should not run.
VBA script of destination worksheet is as follows:
Private Sub CommandButton1_Click()
Dim directory As String, fileName As String, sheet As Worksheet, total As Integer
Dim WrdArray() As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
directory = "C:\test\"
fileName = Dir(directory & "*.xl??")
Application.EnableEvents = False
Do While fileName <> ""
Workbooks.Open (directory & fileName)
WrdArray() = Split(fileName, ".")
For Each sheet In Workbooks(fileName).Worksheets
Workbooks(fileName).ActiveSheet.Name = WrdArray(0)
total = Workbooks("import-sheets.xlsm").Worksheets.Count
Workbooks(fileName).Worksheets(sheet.Name).Copy After:=Workbooks("import-sheets.xlsm").Worksheets(total)
GoTo exitFor:
Next sheet
exitFor:
Workbooks(fileName).Close
fileName = Dir()
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
I appreciate your help in advance

Answer 1

Untested but it should work, source:
https://support.microsoft.com/en-us/kb/291295
Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open filename For Input Lock Read As #filenum
Close filenum ' Close the file.
errnum = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
' Check to see which error occurred.
Select Case errnum
' No error occurred.
' File is NOT already open by another user.
Case 0
IsFileOpen = False
' Error number for "Permission Denied."
' File is already opened by another user.
Case 70
IsFileOpen = True
' Another error occurred.
Case Else
Error errnum
End Select
End Function

Answer 2

if you want to check if a workbook (an Excel file) is opened, try this function.
Public Function isWbOpened(ByVal wb As String) As Boolean
Dim workB As Workbook
isWbOpened = False
For Each workB In Workbooks
If workB.FullName = wb Or workB.Name = wb Then ''FullName : path + filename Name : filename only
isWbOpened = True
End If
Next workB
End Function
if the function return TRUE, then the Excel file is open, so skeep your script.
example:
if isWbOpened("theExcelFile.xlsx") then
msgbox "theExcelFile.xlsx is open"
end if

Answer 3

You can enumerate the files in a folder then test them to see if any is open before proceeding. Please note - the following code is assuming you are the one with them open, so if a shared file is open this may have to be adapted
Sub TestFolder()
Debug.Print XLFileIsOpen("C:\Test")
End Sub
Function XLFileIsOpen(sFolder As String) As Boolean
For Each Item In EnumerateFiles(sFolder)
If IsWorkBookOpen(CStr(Item)) = True Then XLFileIsOpen = True
Next Item
End Function
Function EnumerateFiles(sFolder As String) As Variant
Dim objFSO As Object: Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objFolder As Object: Set objFolder = objFSO.GetFolder(sFolder)
Dim objFile As Object, V() As String
For Each objFile In objFolder.Files
If IsArrayAllocated(V) = False Then
ReDim V(0)
Else
ReDim Preserve V(UBound(V) + 1)
End If
V(UBound(V)) = objFile.Name
Next objFile
EnumerateFiles = V
End Function
Function IsArrayAllocated(Arr As Variant) As Boolean
On Error Resume Next
IsArrayAllocated = IsArray(Arr) And Not IsError(LBound(Arr, 1)) And LBound(Arr, 1) <= UBound(Arr, 1)
End Function
Function IsWorkBookOpen(sFile As String) As Boolean
On Error Resume Next
IsWorkBookOpen = Len(Application.Workbooks(sFile).Name) > 0
End Function