I am using the code below to check if some files are open and get data from them, otherwise open them. When I run the program with the files opened it gives 'Subscript out of range' error.
Sub ReadDatafromOTWK()
'On Error Resume Next
Dim path1 As String
Dim path2 As String
Dim TWb As Workbook
Set TWb = ThisWorkbook
Dim OWb1 As Workbook
Dim OWb2 As Workbook
Dim Curdir As String
'Clear data
TWb.Sheets("OT WK").Range("B7:F1048576").Select
Selection.ClearContents
Range("B7").Select
Curdir = ActiveWorkbook.path
path1 = Curdir & "\" & TWb.Sheets("Instruction").Range("B5")
path2 = Curdir & "\" & TWb.Sheets("Instruction").Range("B6")
'Check if the file is opened
If IsFileOpen(path1) Then
' Display a message stating the file in use.
MsgBox "File already in use!"
'
' Error the line bellow
Set OWb1 = Workbooks(path1)
OWb1.Activate
'GoTo 100
Else
' Display a message stating the file is not in use.
'MsgBox "File not in use!"
' Open the file in Microsoft Excel.
Set OWb1 = Workbooks.Open(path1)
OWb1.Activate
'GoTo 100
End If
End Sub
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