0

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 
Isaac G Sivaa
  • 1,289
  • 4
  • 15
  • 32
Ben2014
  • 160
  • 11
  • Which line is causing the error? (And the first thing you should be doing when you have a problem is commenting out the lines that "turn error checking off", like the one you have at the start of `IsFileOpen()`.) – Ken White Jul 09 '14 at 19:38
  • `Set OWb1 = Workbooks(path1)` What is path1 at the time of error? – dcromley Jul 09 '14 at 19:39
  • possible duplicate of [Detect whether Excel workbook is already open (using VBA)](http://stackoverflow.com/questions/9373082/detect-whether-excel-workbook-is-already-open-using-vba) – hnk Jul 09 '14 at 20:27
  • http://stackoverflow.com/questions/9373082/detect-whether-excel-workbook-is-already-open-using-vba is the second link on google when you search for "Detect whether workbook is open". Please see the answer and close this one. – hnk Jul 09 '14 at 20:27

1 Answers1

0

I don't think you can use the full pathname to refer to an open workbook with the workbooks property - but only its name

IAmDranged
  • 2,890
  • 1
  • 12
  • 6